C
C *** LAST REVISED ON  7-JAN-1988 15:17:47.41
C *** SOURCE FILE: [DL.GRAPHICS.LONGLIB]LONGLIB.FOR
C
C *************************************************************************
C
C	LONGLIB.FOR SOURCE CODE ROUTINES FOR THE PLOTTING LIBRARY
C
C	ONLY VECTOR PLOTTING IS SUPPORTED.
C
C	THIS FILE CONSITS OF THE FIRST SECTION OF THE MAIN PLOT ROUTINES.
C	THIS FILE CONSISTS OF THE DEVICE DEPENDENT ROUTINES.
C	THE RAMTEK COMMUNICATIONS ROUTINES ARE IN A SEPARATE FILE.
C	DEVICE DEPENDENT ROUTINES ARE ALSO CONTAINED IN THE CURSORLIB FILE.
C
C	THIS FILE REFLECTS VERSION 5 OF THE LONGLIB GRAPHICS LIBRARY
C
C	THE SOURCE CODE IN THIS FILE IS COMPATIBLE WITH THE ANSI
C	FORTRAN 77 STANDARDS WITH THE FOLLOWING EXCEPTIONS:
C		1. TABS (^I) ARE USED TO INDENT LINES.
C		2. AN "INTEGER*2" DECLARTION IS USED IN PPLOTP.
C		   THIS MAY REPLACED BY AN "INTEGER" STATMENT AT THE EXPENSE
C		   OF LARGER PRINTER HISTORY FILE SIZES
C		3. A "BYTE" DATA TYPE IS USED IN VTPLOT AND CTERM
C		   THESE MAY BE REPLACED WITH "CHARACTER*1" IF THE
C		   CODE IN VTPLOT IS APPROPRIATELY MODIFIED.
C		4. TRAILING COMMENTS WITH A "!" CHARACTER ARE USED
C		   EXTENSIVELY.
C		5. SUBROUTINE AND VARIABLE NAMES OCCASIONALLY EXCEED
C		   SIX CHARACTERS IN LENGTH.
C
C	THE FOLLOWING ARE MACHINE DEPENDENT:
C		1. THE '$' IN A FORMAT STATEMENT CAUSES THE CURSOR
C		   TO BE LEFT AT THE END OF THE STATEMENT ON A PROMPT
C		2. A '+' IN A FORMAT STATEMENT INHIBITS A LINE FEED.
C		3. THE FUNCTION "IAND" RETURNS THE BIT-WISE AND OF TWO
C		   INTEGER ARGUMENTS WHILE "IOR" RETURNS BIT-WISE OR.
C		4. THE READ AND WRITE LOGICAL FILE UNITS FOR TERMINAL
C		   ARE "*".
C		5. ROUTINES TO SUPPORT THE VAX CONTROL-C INTERRUPT
C		   ARE INCLUDED BUT MAY BE COMMENTED OUT.
C		6. THE ROUTINE "EXIT" IN FRAME STOPS THE EXECUTION
C		   OF THE PROGRAM
C
C *************************************************************************
C
	SUBROUTINE FRAME(IPL,ID,VPX,VPY,ZOM)
C
C	ROUTINE TO INTIALIZE THE LONGLIB GRAPHICS PLOT PACKAGE
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C	+ ADD CONTROL-C INTERRUPT ENABLE CALL
C	  CAN BE COMMENTED OUT IF DESIRED
C
C	IPL	LOGICAL DEVICE NUMBER FOR PRINTER DATA FILE (NORMALLY 3)
C		> 0 FORTRAN FILE TYPE NUMBER
C		= 0 ASK IF PRINT FILE DESIRED (DEFAULT FILE 3)
C		< 0 DO NOT CREATE PRINTER FILE
C	ID	DEVICE TYPE
C		< 0 DO NOT CLEAR SCREEN OF SCREEN DEVICE
C		= 0 ASK WHICH SCREEN DEVICE TO USE (? FOR HELP)
C		= 1 USE VT100 TERMINAL EQUIPPED WITH SELNAR GR100+
C		= 2 USE RAMTEK ONLY
C		= 3 USE BOTH RAMTEK AND VT100 WITH SELNAR GR100 OR GR100+
C		= 4 USE NO SCREEN DEVICE
C		= 5 USE VT125 TERMINAL IN TEKTRONICS 4010 MODE
C		= 6 USE VT100 TERMINAL WITH SELNAR GR100 IN TEKTRONICS 4010 MODE
C		= 7 USE VT100 TERMINAL WITH SELNAR GR480
C		= 8 USE VT240 TERMINAL (TEK 4010 MODE, VT100 MODE)
C		= 9 USE VT220 TERMINAL WITH SELNAR SG220 (TEK 4014)
C		= 10 USE TEKTRONICS 4010 TERMINAL
C		= 11 USE TEKTRONICS 4107 COLOR TERMINAL
C		= 12 USE GRAPHON GO-235 TERMINAL
C	VPX,VPY COORDINATES OF BOTTOM LEFT ORIGIN
C	ZOM	ZOOM FACTOR
C		< 0 USE SMALL RAMTEK SCREEN
C
	CHARACTER*1 ANS
	COMMON/PXPCOM/LU,MP,RE(2),OX,OY,SF,PX,PY,MX,MW,MCOL,MSC,
     $		PANG,PVP(4)
	COMMON/RMTEK/ICHAN,IMR(128),RRE(2),ROX,ROY,RSF,NIMR,RANG,MM,IPW,
     $		IPSC,ICOL,RVP(4),IRID,RLIM(2),IRXLIM,IRYLIM,IDDEV
	COMMON/VT100/IVT100,IMV(32),VRE(2),VOX,VOY,VSF,NIMV,VANG,ITERM,
     $		VVP(4),MV,MVW,IVCOL,IXLIM,IYLIM,IYREV,VLIM(2),IMODE
C
	CALL ENABLEAST			! ENABLE CONTROL-C INTERRUPT CODE
C
	KPL=IPL
	Z=ZOM
	IF (KPL.EQ.0) THEN
16		WRITE(*,1)
1		FORMAT('$Create Longlib Meta File? (Y/N) [N] ')
		READ(*,2,END=99) ANS
2		FORMAT(A1)
		IANS=ICHAR(ANS)
		KPL=-3
		IF (IANS.EQ.89.OR.IANS.EQ.121) KPL=3
		IF (IANS.EQ.63) GOTO 16
	ENDIF
	LU=-1
	IF (KPL.GT.0) CALL PPLOTS(KPL,VPX,VPY,ABS(Z))	! INTIALIZE PRINTER
	IDD=IABS(ID)
	IDDN=-ISIGN(1,ID)			! SET CLEAR SCREEN FLAG
	IF (IDD.EQ.0) THEN
		IDDN=-1		! CLEAR SCREEN WHEN PROMPTED
5		WRITE(*,3)
3		FORMAT('$Longlib Screen Graphics Device? [?=Help] ')
		READ(*,2,END=99) ANS
C
C	CONVERT INPUT CHARACTER INTO UPPER CASE ASCII VALUE
C
		IANS=ICHAR(ANS)
		IF (IANS.GT.96) IANS=IANS-32
C
C	INPUT WAS A QUESTION MARK?
C
		IF (IANS.EQ.63) THEN
			WRITE(*,4)
4		FORMAT(/' Available Screen Devices:'/,4X,'R : 1024 Ramtek'/
     $		4X,'r : 512 Ramtek'/,4X,'V : Vt100 w/Selnar Gr100'/,4X,
     $		'T : VT125'/,4X,'F : VT240'/,4X,
     $		'D : VT220 w/Selnar Sg220'/,4X,'E : Tektronics 4010/14'/,
     $		4X,'A : Tektronics 4107/109'/,4X,'G : GraphOn GO-235'/,
     $		4X,'X : Exit '/,4X,'N : None [default]'/)
			GOTO 5
		ENDIF
		IDD=4		! DEFAULT = NO SCREEN DEVICE
C
C	DECODE TERMINAL SCREEN OPTION
C
		IF (IANS.EQ.88) GOTO 99	! END PROGRAM
		IF (IANS.EQ.82.OR.IANS.EQ.50.OR.IANS.EQ.51) THEN
			IDD=2		! RAMTEK
			IF (ICHAR(ANS).EQ.114) Z=-ABS(Z)! SMALL RAMTEK
		ENDIF
		IF (IANS.EQ.83) IDD=6 	! SELNAR GR100
		IF (IANS.EQ.86) IDD=6	! SELNAR GR100
		IF (IANS.EQ.75) IDD=6	! SELNAR GR100
		IF (IANS.EQ.84) IDD=5	! VT125 4010
		IF (IANS.EQ.70) IDD=8	! VT240 (4010)
		IF (IANS.EQ.68) IDD=9	! VT220 (4010)
		IF (IANS.EQ.69) IDD=10	! Tektronics 4010/4014
		IF (IANS.EQ.65) IDD=11	! Tektronics 4107/4109
		IF (IANS.EQ.71) IDD=12	! GRAPHON GO-235 (ENHANCED)
	ENDIF
	ICHAN=-1		! DISABLE RAMTEK BY DEFAULT 
	IVT100=-1		! DISABLE TERMINAL BY DEFAULT
	IF (IDD.NE.2.AND.IDD.NE.4) CALL VPLOTS(IDD*IDDN,VPX,VPY,Z) ! INITALIZE VT100
	IF (IDD.EQ.2.OR.IDD.EQ.3) CALL RPLOTS(IDD*IDDN,VPX,VPY,Z) ! INTIALIZE RAMTEK
	RETURN
99	CONTINUE
C
C	DO IMMEDIATE EXIT FROM PROGRAM
C
	CALL EXIT
	RETURN
	END
C
C
	SUBROUTINE PLOTS(I,J)
C
C	THIS SUBROUTINE PROVIDES PLOTS-10 COMPATIBILITY
C	ARGUMENTS ARE IGNORED.  CALL FRAME WITH PROMPT FOR
C	HARDCOPY AND GRAPHICS SCREEN OUTPUTS.
C
	CALL FRAME(0,0,0.,0.,1.)
	RETURN
	END
C
C
	SUBROUTINE VPLOTS(ID,VPX,VPY,ZOM)
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C
C	THIS ROUTINE INITIALIZES THE TERMINAL GRAPHICS DEVICE
C
	COMMON/VT100/IVT100,IMV(32),VRE(2),VOX,VOY,VSF,NIMV,VANG,ITERM,
     $		VVP(4),MV,MVW,IVCOL,IXLIM,IYLIM,IYREV,VLIM(2),IMODE
C
	NIMV=1			! RESET VECTOR BUFFTER
	IMV(1)=0		! ORIGIN VECTOR BUFFER
	IMV(2)=0		! ORIGIN VECTOR BUFFER
	VOX=VPX 		! ORIGIN
	VOY=VPY 		! ORIGIN
	VSF=ABS(ZOM)		! SCALE FACTOR
	VANG=0.
	ITERM=1			! SELNAR GR100	(DEFAULT)
	IF (IABS(ID).EQ.5) ITERM=2	! VT125 TEK 4010 MODE
	IF (IABS(ID).EQ.8) ITERM=3	! VT240 TEK 4010 MODE
	IF (IABS(ID).EQ.9) ITERM=4	! VT220 W/SELNAR SG220 (TEK 4014)
	IF (IABS(ID).EQ.10) ITERM=5	! Tektronics 4010/4014
	IF (IABS(ID).EQ.11) ITERM=6	! Tektronics 4107/4109
	IF (IABS(ID).EQ.12) ITERM=7	! GRAPHON GO-235
	IF (VSF.LE.0.0) VSF=1.0
	VRE(1)=9.5/4096.! TEK 4010 RESOLUTION X (1024 PIXELS = 9.5 INCHES)
	VRE(2)=VRE(1)
	VLIM(1)=4095.	! TEK 4010 SCREEN PIXEL SIZE (X)
	VLIM(2)=3119.	! TEK 4010 SCREEN PIXEL SIZE (Y)
	IXLIM=VLIM(1)
	IYLIM=VLIM(2)
	IYREV=0		! DO NOT INVERT Y DIMENSION COORDINATE
	IF (ITERM.EQ.5) THEN	! TEK 4014 MODE SCALING WITH FULL SIZE SCREEN
		VRE(1)=9.5/4096.! TEK 4014 RESOLUTION X (1024 PIXELS = 9.5 INCHES)
		VRE(2)=VRE(1)
		VLIM(1)=4095.	! TEK 4014 SCREEN PIXEL SIZE (X)
		VLIM(2)=4095.	! TEK 4010 SCREEN PIXEL SIZE (Y)
		IXLIM=VLIM(1)
		IYLIM=VLIM(2)
		IYREV=0		! DO NOT INVERT Y DIMENSION COORDINATE
	ENDIF
	IF (ITERM.EQ.6) THEN	! TEK 4107 MODE SCALING
		VRE(1)=10./4096.! TEK 4107 RESOLUTION X (4107 PIXELS = 10 INCHES)
		VRE(2)=VRE(1)
		VLIM(1)=4095.	! TEK 4107 SCREEN PIXEL SIZE (X)
		VLIM(2)=4095.	! TEK 4107 SCREEN PIXEL SIZE (Y)
		IXLIM=VLIM(1)
		IYLIM=VLIM(2)
		IYREV=0		! DO NOT INVERT Y DIMENSION COORDINATE
	ENDIF
	IVT100=1		! ENABLE TERMINAL GR OUTPUT
	CALL CTERM(0)		! SET TERMINAL TO GR SCREEN
	VVP(1)=0.0		! VIEW PORT PARAMETERS LOWER-LEFT
	VVP(2)=0.0
	CALL PLOTVT(999.,999.,4)! SET RIGHT VIEWPORT PARAMETERS UPPER-RIGHT
	IF (ID.LE.0) CALL PLOTVT(-1.,0.,0)	! CLEAR TERMINAL SCREEN
	CALL NEWVPEN(0,1)			! SET DEFAULT PEN TYPE,WIDTH
	CALL NEWVCOL(-1)			! INIT. COLOR GRAPHICS
	CALL NEWVCOL(1)				! SET DEFAULT PEN COLOR
	RETURN
	END
C
C
	SUBROUTINE VTPLOT(N,M,IE,LWIDE)
C
C	PLOTS PIXEL MAPPED VECTOR TO TERMINAL GRAPHICS SCREEN
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C
C	TERMINAL MUST BE IN GRAPHICS MODE PRIOR TO CALL
C
C N	NUMBER OF POINTS
C M	ARRAY OF POINTS TO BE OUTPUT
C		M(1) = X1
C		M(2) = Y1
C		M(3) = X2
C		M(4) = Y2,... ETC
C IE    ERASE FLAG 
C		0=NORMAL (DRAW VISIBLE)
C		1=XOR    (IF NOT SUPPORTED, DRAW VISIBLE)
C		2=ERASE  (IF NOT SUPPORTED, DRAW VISIBLE)
C		3=XOR    (IF NOT SUPPORTED, DRAW ERASE)
C LWIDE	LINE WIDTH (SIMULATED)
C
	INTEGER M(1)
	BYTE ESC,US,GS,HIX,LOX,HIY,LOY,EX,LHIX,LHIY,LLOY,LEX,B(79)
	COMMON/VT100/IVT100,IMV(32),VRE(2),VOX,VOY,VSF,NIMV,VANG,ITERM,
     $		VVP(4),MV,MVW,IVCOL,IXLIM,IYLIM,IYREV,VLIM(2)
	DATA ESC/27/,GS/29/,US/31/
	LOGICAL EXTRA
C
C	LINE WIDTH ARRAYS
C
	INTEGER MWP(4),MWX(26),MWY(26)
	DATA MWP/1,5,12,26/
	DATA MWX/0,-1,1,1,-1,-1,0,2,1,0,0,-1,0,-1,-1,-1,0,0,1,1,1,1,
     $   1,0,0,-1/
	DATA MWY/0,0,1,-1,-1,0,2,0,0,-1,-1,0,-1,0,0,1,1,1,1,0,0,0,-1,
     $   -1,-1,-1/
C
	IF (N.LT.1.OR.IVT100.LT.0) RETURN
C
C	USE EXTRA TEKTRONICS BYTE?
C
	EXTRA=.FALSE.
	IF (ITERM.EQ.6) EXTRA=.TRUE.	
C
	IF (IE.NE.0) THEN			 ! ERASE OR XOR DESIRED
		IF (ITERM.EQ.4) WRITE(*,77) ESC,96+IE! SELNAR SG220 ERASE/XOR
77		FORMAT('+',A1,'OW ',A1,'` @@',$) ! SELNAR SG220 ERASE/XOR
		IF (ITERM.EQ.7) THEN		! GRAPHON G0-235
			IF (IE.EQ.2) THEN	! ERASE
				WRITE(*,125) ESC,16
			ELSE			! XOR
				WRITE(*,125) ESC,21
			ENDIF
		ENDIF
	ENDIF
C
C	MAKE MULTIPLE PASSES TO SIMULATE LINE WIDTH	
C
	IADD=4
	IF (EXTRA) IADD=1
C
	LW1=MIN(LWIDE,7)
	LW1=MAX(LW1,1)
	LW=MWP(LW1)
	DO 500 IW=1,LW
C
C	SET TEKTRONICS VECTOR MODE GRAPHICS COMMAND
C
	B(1)=GS
	IB=2
C
C	COMPUTE HI-RES TEKTRONICS COORDINATES BUT SEND ONLY APPROPRIATE DATA
C
	N2=2*N
	DO 100 I=1,N2,2
C
		M(I)  =M(I)  +MWX(IW)*IADD
		M(I+1)=M(I+1)+MWY(IW)*IADD
		MX=M(I)
		MY=M(I+1)
C
C	CLIP TO SCREEN COORDINATES
C
		MX=MIN(MX,4095)
		MY=MIN(MY,4095)
		MX=MAX(MX,0)
		MY=MAX(MY,0)
C
C	COMPUTE HI-RES TEKTRONICS COORDINATES
C
		HIX=32+MX/128			! HI-X
		LOX=64+MOD(MX/4,32)		! LO-X
		HIY=32+MY/128			! HI-Y
		LOY=96+MOD(MY/4,32)		! LO-Y
		EX=96+MOD(MY,4)*4+MOD(MX,4)	! EXTRA
C
C	USE TEXTRONICS CODING STANDARD TO MINIMIZE BYTES SET TO TERMINAL
C
		IF (I.GT.1) THEN
			IF (LHIY.NE.HIY) THEN
				B(IB)=HIY
				IB=IB+1
			ENDIF
			IF (EXTRA.AND.LEX.NE.EX) THEN
				B(IB)=EX
				B(IB+1)=LOY
				IB=IB+2
				IF (LHIX.NE.HIX) THEN
					B(IB)=HIX
					IB=IB+1
				ENDIF
			ELSE
				IF (LOY.NE.LLOY) THEN
					B(IB)=LOY
					IB=IB+1
					IF (LHIX.NE.HIX) THEN
						B(IB)=HIX
						IB=IB+1
					ENDIF
				ELSE
					IF (LHIX.NE.HIX) THEN
						B(IB)=LOY
						B(IB+1)=HIX
						IB=IB+2
					ENDIF
				ENDIF
			ENDIF
			B(IB)=LOX
			IB=IB+1
		ELSE
			B(IB)=HIY
			IB=IB+1
			IF (EXTRA) THEN
				B(IB)=EX
				IB=IB+1
			ENDIF
			B(IB)=LOY
			B(IB+1)=HIX
			B(IB+2)=LOX
			IB=IB+3
		ENDIF
		LHIX=HIX
		LHIY=HIY
		LLOY=LOY
		LEX=EX
		IF (IB.GT.73) THEN	! DUMP LINE BUFFER
			B(IB)=US
			WRITE(*,125) (B(J),J=1,IB)
			B(1)=GS
			B(2)=LOX
			IB=3
		ENDIF
100	CONTINUE
C
	B(IB)=US		! END VECTOR MODE
	IF (IB.GT.3) WRITE(*,125) (B(J),J=1,IB)
125	FORMAT('+',79A1)
C
500	CONTINUE
C
	IF (IE.NE.0) THEN		! ERASE OR XOR DESIRED
		IF (ITERM.EQ.4) WRITE(*,77) ESC,96 ! RESTORE SELNAR SG220 NORM WRIIT
		IF (ITERM.EQ.7) WRITE(*,125) ESC,1	!GRAPHON
	ENDIF
	RETURN
	END
C
C
	SUBROUTINE NEWVPEN(IT,IW)
C
C	THIS ROUTINE CHANGES THE TERMINAL LINE TYPE ON TERMINAL
C	TERMINAL MUST BE IN GRAPHICS MODE
C
C	IT = LINE TYPE (IF TERMINAL HARDWARE SUPPORTS)
C	IW = LINE WIDTH (IF SUPPORTED)
C
	COMMON/VT100/IVT100,IMV(32),VRE(2),VOX,VOY,VSF,NIMV,VANG,ITERM,
     $		VVP(4),MV,MVW,IVCOL,IXLIM,IYLIM,IYREV,VLIM(2)
C
	INTEGER ESC
	DATA ESC/27/
C
	IF (IVT100.LT.0) RETURN
	MV=IT
	MVW=IW
C
CC	IF (ITERM.EQ.6) WRITE(*,20) ESC,'M','V',IT+47	! TEK4107
	WRITE(*,20) ESC,IT+96			! TEK COMMAND FORMAT
20	FORMAT('+',2A1,$)
	RETURN
	END
C
C
	SUBROUTINE NEWVCOL(IC)
C
C	THIS ROUTINE CHANGES THE TERMINAL LINE COLOR
C	TERMINAL MUST BE IN GRAPHICS MODE
C
C	IC = LINE COLOR (IF SUPPORTED BY TERMINAL HARDWARE)
C
	COMMON/VT100/IVT100,IMV(32),VRE(2),VOX,VOY,VSF,NIMV,VANG,ITERM,
     $		VVP(4),MV,MVW,IVCOL,IXLIM,IYLIM,IYREV,VLIM(2)
C
	INTEGER ESC
	DATA ESC/27/
C
	IF (IVT100.LT.0) RETURN
	IF (IC.LT.0) THEN		! INITIALIZE COLOR GRAPHICS
	ELSE				! CHANGE LINE COLOR
		IVCOL=IC
		IF (ITERM.EQ.6) THEN	! TEK4107 COLOR COMMAND
			WRITE(*,20) ESC,MOD(IC,15)+48
20			FORMAT('+',A1,'ML',A1)
		ENDIF
	ENDIF
	RETURN
	END
C
C
	SUBROUTINE CTERM(IX)
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C
C	CONTROLS A GRAPHICS TERMINAL
C
C	NOTE: NOT ALL OPTIONS ARE AVAILABLE IN ALL GRAPHICS DEVICES.
C
C IX	CONTROL FLAG
C	= 0 PUT TERMINAL IN GRAPHICS MODE, CLEAR TERMINAL SCREEN
C	= 1 RETURN TERMINAL TO TERMINAL MODE
C	=-1 RETURN TERMINAL TO GRAPHICS MODE
C	= 2 RETURN TERMINAL TO TERMINAL MODE, ASK IF GRAPHICS SCREEN CLEAR
C	=-2 RETURN TERMINAL TO TERMINAL MODE, CLEAR SCREEN
C	= 3 CLEAR TERMINAL SCREEN, LEAVE IN GRAPHICS MODE
C	=-3 CLEAR GRAPHICS SCREEN, LEAVE IN GRAPHICS MODE
C	= 4 DUMP GRAPHICS SCREEN TO PRINTER, LEAVE IN GRAPHICS
C	=-4 CLEAR TERMINAL AND GRAPHICS SCREEN, LEAVE IN GRAPHICS MODE
C	= 5 TURN OFF GRAPHICS SCREEN, RETURN TO TERMINAL MODE
C	=-5 TURN ON GRAPHICS SCREEN, RETURN TO GRAPHICS MODE
C	= 6 TOGGLE REVERSE VIDEO, LEAVE IN GRAPHICS
C	= 8 RESTORE TERMINAL TO ANSI MODE
C
C	FOR SELNAR EQUIPPED VT100, VT220 AND VT125, CTERM SWITCHES BACK AND
C	FORTH BETWEEN THE TERMINAL MODE AND GRAPHICS MODE.  THE VT240 CLEARS
C	THE SCREEN EACH TIME THIS IS DONE SO THIS EFFECT IS INHIBITED.  FOR THE
C	VT240, CTERM ONLY SWITCHES IT INTO THE TEK 4010 MODE AND LEAVES IT
C	THERE UNTIL THE (8) CALL WHEN PLOTND IS CALLED.
C
C	TERMINALS WHICH DO NOT HAVE THE TEXT AND GRAPHICS ON SEPARATE
C	PLANES SET THE ALPHA CURSOR TO THE HOME POSITION BEFORE RETURNING
C	TO "TEXT" POSITION.
C
	COMMON/VT100/IVT100,IMV(32),VRE(2),VOX,VOY,VSF,NIMV,VANG,ITERM,
     $		VVP(4),MV,MVW,IVCOL,IXLIM,IYLIM,IYREV,VLIM(2),IMODE
C
C	ESCAPE SEQUENCES REQUIRED TO CONTROL TERMINAL/GRAPHICS MODE
C	DIMENSIONED: ACTION(#CHARACTERS+1,#OF DEVICES)
C		#DEVICES = 6, #CHARACTERS=7
C	NOTE: LAST CHARACTER CONTAINS NUMBER OF CHARS IN COMMAND ACTIONS:
C	"VTERM" PUTS TERMINAL IN TERMINAL MODE
C	"GTERM" PUTS TERMINAL IN GRAPHICS MODE
C	"VCLEAR" CLEARS TERMINAL MODE SCREEN
C	"GCLEAR" CLEARS GRAPHICS MODE SCREEN
C
	BYTE VTERM(7,7),GTERM(7,7),VCLEAR(7,7),GCLEAR(7,7),ESC
	DATA ESC/27/		! ASCII ESCAPE
	CHARACTER*1 ANS
	CHARACTER*(*) HOME
	PARAMETER (HOME=CHAR(29)//CHAR(63)//CHAR(111)//CHAR(32)//
     $			CHAR(64)//CHAR(31))
C
	BYTE SG100VT(7), SG100GT(7), SG100VC(7), SG100GC(7) ! SELNAR GR100 TEK MODE
	BYTE VT125VT(7), VT125GT(7), VT125VC(7), VT125GC(7)  ! VT125+RETRO
	BYTE VT240VT(7), VT240GT(7), VT240VC(7), VT240GC(7)  ! VT240 4010 MODE
	BYTE VT220VT(7), VT220GT(7), VT220VC(7), VT220GC(7)  ! VT220 SG100
	BYTE T4010VT(7), T4010GT(7), T4010VC(7), T4010GC(7)  ! TEK 4010
	BYTE T4107VT(7), T4107GT(7), T4107VC(7), T4107GC(7)  ! TEK 4107
	BYTE GO235VT(7), GO235GT(7), GO235VC(7), GO235GC(7)  ! GRAPHON GO-235
C
	EQUIVALENCE (VTERM(1,1),SG100VT),(GTERM(1,1),SG100GT),
     $		(VCLEAR(1,1),SG100VC),(GCLEAR(1,1),SG100GC)
	EQUIVALENCE (VTERM(1,2),VT125VT),(GTERM(1,2),VT125GT),
     $		(VCLEAR(1,2),VT125VC),(GCLEAR(1,2),VT125GC)
	EQUIVALENCE (VTERM(1,3),VT240VT),(GTERM(1,3),VT240GT),
     $		(VCLEAR(1,3),VT240VC),(GCLEAR(1,3),VT240GC)
	EQUIVALENCE (VTERM(1,4),VT220VT),(GTERM(1,4),VT220GT),
     $		(VCLEAR(1,4),VT220VC),(GCLEAR(1,4),VT220GC)
	EQUIVALENCE (VTERM(1,5),T4010VT),(GTERM(1,5),T4010GT),
     $		(VCLEAR(1,5),T4010VC),(GCLEAR(1,5),T4010GC)
	EQUIVALENCE (VTERM(1,6),T4107VT),(GTERM(1,6),T4107GT),
     $		(VCLEAR(1,6),T4107VC),(GCLEAR(1,6),T4107GC)
	EQUIVALENCE (VTERM(1,7),GO235VT),(GTERM(1,7),GO235GT),
     $		(VCLEAR(1,7),GO235VC),(GCLEAR(1,7),GO235GC)
C
	DATA SG100VT/27,50,0,0,0,0,2/		! <ESC>2      SELNAR GR100 IN
	DATA SG100GT/27,49,27,42,0,0,4/		! <ESC>1<ESC>* TEK 4010 MODE
	DATA SG100VC/27,91,50,74,0,0,4/		! <ESC>[2J
	DATA SG100GC/27,42,27,12,0,0,4/		! <ESC>*<ESC><FF>
C
	DATA VT125VT/24,0,0,0,0,0,1/		! <CAN>(^X) VT125 (VT100+RETRO)
	DATA VT125GT/29,0,0,0,0,0,1/		! <GS> (^])
	DATA VT125VC/27,91,50,74,0,0,4/		! <ESC>[2J
	DATA VT125GC/27,12,0,0,0,0,2/		! <ESC><FF>
C
	DATA VT240VT/27,91,63,51,56,108,0/	! <ESC>[?38l  VT240 7 BIT 
	DATA VT240GT/27,91,63,51,56,104,0/	! <ESC>[?38h	CONTROLS
	DATA VT240VC/27,91,50,74,0,0,0/		! <ESC>[2J
	DATA VT240GC/27,12,0,0,0,0,2/		! <ESC><FF>
C
	DATA VT220VT/27,50,27,91,52,105,6/	! <ESC>2<ESC>[4i  VT220 (SG220)
	DATA VT220GT/27,91,53,105,27,49,6/	! <ESC>[5i<ESC>1  
	DATA VT220VC/27,91,50,74,0,0,4/		! <ESC>[2J
	DATA VT220GC/27,12,0,0,0,0,2/		! <ESC><FF>
C
	DATA T4010VT/0,0,0,0,0,0,0/		! Tek 4010/4014
	DATA T4010GT/0,0,0,0,0,0,0/		! 
	DATA T4010VC/27,12,0,0,0,0,2/		! <ESC><FF>
	DATA T4010GC/27,12,0,0,0,0,2/		! <ESC><FF>
C
	DATA T4107VT/0,0,0,0,0,0,0/		! Tek 4107/4109
	DATA T4107GT/0,0,0,0,0,0,0/		!
	DATA T4107VC/27,76,90,0,0,0,3/		! <ESC>LZ (DIALOG CLEAR)
	DATA T4107GC/27,12,0,0,0,0,2/		! <ESC><FF>
C
	DATA GO235VT/24,0,0,0,0,0,1/		! <CAN>  GRAPHON GO-235
	DATA GO235GT/29,0,0,0,0,0,1/		! <GS>
	DATA GO235VC/27,91,50,74,0,0,4/		! <ESC>[2J
	DATA GO235GC/27,97,27,12,0,0,4/		! <ESC>a<ESC><FF>
C
	DATA ITOG/0/			! SCREEN TOGGLE FLAG
C
	IF (IVT100.EQ.-99.AND.IX.EQ.2) GOTO 80	! SPECIAL SKIP PLOTTING IN EFFECT
	IF (IVT100.LE.0) RETURN			! TERMINAL NOT IN USE
	IF (IABS(IX).GT.8) RETURN		! INVALID OPTION
C
C	OPTION SWITCH
C
1	FORMAT('+',6A1,$)
2	FORMAT('+',A6)
	GOTO (60,30,100,120,20,85,70,10,40,80,15,130,110,30,50,180),IX+8
99	RETURN
C
10	CONTINUE				! INIT GR SCREEN, CLEAR TERMINAL SCREEN ONLY
	IF (ITERM.EQ.6) THEN
		WRITE(*,1) ESC,91,50,74	! TEK4107 ANSI MODE CLEAR SCREEN
		WRITE(*,1) ESC,37,33,48	! TEK4107 TO TEK MODE
	ENDIF
	WRITE(*,1) (VTERM(I,ITERM),I=1, VTERM(7,ITERM))
	WRITE(*,1)(VCLEAR(I,ITERM),I=1,VCLEAR(7,ITERM))
	WRITE(*,1) (GTERM(I,ITERM),I=1, GTERM(7,ITERM))
	WRITE(*,1)(GCLEAR(I,ITERM),I=1,GCLEAR(7,ITERM))
	IMODE=1				! GRAPHICS MODE
	GOTO 99
15	CONTINUE				! CLEAR TERMINAL SCREEN, GR MODE
	WRITE(*,1) (VTERM(I,ITERM),I=1, VTERM(7,ITERM))
	WRITE(*,1)(VCLEAR(I,ITERM),I=1,VCLEAR(7,ITERM))
	WRITE(*,1) (GTERM(I,ITERM),I=1, GTERM(7,ITERM))
	IF (ITERM.EQ.4) WRITE(*,1) (GTERM(I,ITERM),I=1,6)	! VT240
	IMODE=1				! GRAPHICS MODE
	GOTO 99
20	CONTINUE				! CLEAR GRAPHICS SCREEN, GR MODE
	IF (ITERM.EQ.4) WRITE(*,1) (GTERM(I,ITERM),I=1,6)	! VT240
	WRITE(*,1) (GTERM(I,ITERM), I=1, GTERM(7,ITERM))
	WRITE(*,1) (GCLEAR(I,ITERM),I=1,GCLEAR(7,ITERM))
	IMODE=1				! GRAPHICS MODE
	GOTO 99
30	CONTINUE				! TOGGLE VIDEO SCREEN
	IF (ITERM.EQ.1) WRITE(*,1) ESC,48,ESC,40	! SELNARS
	IF (ITERM.EQ.7) WRITE(*,1) ESC,91,49+ITOG,35,122	! GRAPHON
	ITOG=ITOG+1
	IF (ITOG.GE.2) ITOG=1
	GOTO 99
40	CONTINUE				! TERMINAL MODE
	WRITE(*,1) (GTERM(I,ITERM),I=1,GTERM(7,ITERM))
	WRITE(*,2) HOME
	WRITE(*,1) (VTERM(I,ITERM),I=1,VTERM(7,ITERM))
	IMODE=0				! TERMINAL MODE
	GOTO 99
50	CONTINUE
60	CONTINUE
	GOTO 99
70	CONTINUE				! GRAPHICS MODE
	WRITE(*,1) (GTERM(I,ITERM),I=1,GTERM(7,ITERM))
	IMODE=1				! GRAPHICS MODE
	GOTO 99
80	CONTINUE				! CLEAR SCREEN PROMPT
	IF (IVT100.EQ.-99) THEN		! MULTIPLE PASS SKIPPING
		ISKIP=ISKIP-1
		IF (ISKIP.GT.0) GOTO 99
	ELSE
		ISKIP=0
	ENDIF
	WRITE(*,1) (GTERM(I,ITERM),I=1,GTERM(7,ITERM))
	WRITE(*,2) HOME
	WRITE(*,1) (VTERM(I,ITERM),I=1,VTERM(7,ITERM))
	IMODE=0				! TERMINAL MODE
505	WRITE(*,5)
5	FORMAT('$Clear Screen? (y,n,q,s,d) [y] ')
	READ(*,6) ANS
6	FORMAT(A1)
C
C	CONVERT INPUT CHARACTER TO UPPER CASE ANSII
C
	IANS=ICHAR(ANS)
	IF (IANS.GE.96) IANS=IANS-32
C
C	QUESTION MARK REPLY
C
	IF (IANS.EQ.63) THEN
		WRITE(*,84)
84		FORMAT(/' Y : Clear screen [default]'/' n : No clear '/
     $		' q : Quit (disable screen plotting)'/
     $		' s : Skip screen plotting until next "cterm(2)"'/
     $		' p : Skip screen plotting until specified "cterm(2)"'/
     $		' d : Dump screen to terminal printer'/)
		GOTO 505
	ENDIF
C
C	Y OR NO REPLY
C
	IF (IANS.EQ.89.OR.IANS.EQ.32) THEN
		IVT100=1			! ONLY WHEN IVT100=-99
85		CONTINUE			! CLEAR BOTH SCREENS
		WRITE(*,1)(VCLEAR(I,ITERM),I=1,VCLEAR(7,ITERM))
		WRITE(*,1) (GTERM(I,ITERM),I=1, GTERM(7,ITERM))
		WRITE(*,1)(GCLEAR(I,ITERM),I=1,GCLEAR(7,ITERM))
		WRITE(*,1) (VTERM(I,ITERM),I=1, VTERM(7,ITERM))
		WRITE(*,1)(VCLEAR(I,ITERM),I=1,VCLEAR(7,ITERM))
	ELSE
		IF (IANS.EQ.81) IVT100=-1	! TURN OFF VT100 PLOTTING
		IF (IANS.EQ.83) THEN		! SKIP PLOTTING
			IVT100=-99  
			ISKIP=0
		ENDIF
		IF (IANS.EQ.68) GOTO 130	! DUMP TO PRINTER
		IF (IANS.EQ.80) THEN		! PASS SKIP
			IVT100=-99  
			WRITE(*,86)
86			FORMAT('$Number of CTERM(2)s to skip? ')
			READ(*,*) ISKIP
		ENDIF
	ENDIF
	GOTO 99
90	CONTINUE				! TERMINAL SCREEN CLEAR, T MODE
	WRITE(*,1) (GTERM(I,ITERM),I=1,GTERM(7,ITERM))
	WRITE(*,2) HOME
	WRITE(*,1) (VTERM(I,ITERM),I=1, VTERM(7,ITERM))
	WRITE(*,1) (VCLEAR(I,ITERM),I=1,VCLEAR(7,ITERM))
	IMODE=0				! TERMINAL MODE
	GOTO 99
100	CONTINUE				! TURN GR SCREEN OFF
	WRITE(*,1) (GTERM(I,ITERM),I=1,GTERM(7,ITERM))
	IF (ITERM.EQ.1) WRITE(*,1) ESC,39	! SELNARS (')
	IF (ITERM.EQ.7) WRITE(*,1) ESC,91,48,35,122	! GRAPHON
	WRITE(*,1) (VTERM(I,ITERM),I=1,VTERM(7,ITERM))
	IMODE=0				! TERMINAL MODE
	GOTO 99
110	CONTINUE				! TURN GR SCREEN ON
	WRITE(*,1) (GTERM(I,ITERM),I=1,GTERM(7,ITERM))
	IF (ITERM.EQ.1) WRITE(*,1) ESC,34	! SELNARS (")
	IF (ITERM.EQ.7) WRITE(*,1) ESC,91,50,35,122	! GRAPHON
	IMODE=1				! GRAPHICS MODE
	GOTO 99
120	CONTINUE				! CLEAR BOTH SCREENS
	WRITE(*,1) (GTERM(I,ITERM),I=1, GTERM(7,ITERM))
	WRITE(*,1)(GCLEAR(I,ITERM),I=1,GCLEAR(7,ITERM))
	WRITE(*,1) (VTERM(I,ITERM),I=1, VTERM(7,ITERM))
	WRITE(*,1)(VCLEAR(I,ITERM),I=1,VCLEAR(7,ITERM))
	IMODE=0				! TERMINAL MODE
	GOTO 99
130	CONTINUE				! DUMP GRAPHICS TO PRINTER
	WRITE(*,1) (GTERM(I,ITERM),I=1,GTERM(7,ITERM))
CC	IF (ITERM.EQ.1) WRITE(*,1) ESC,59,ESC,58	! SELNARS
	WRITE(*,1) ESC,23 ! VT125,VT240,VT220,AND TEKS
	IMODE=1				! GRAPHICS MODE
	GOTO 99
180	CONTINUE			! DE-INITIALIZE GRAPHICS TERMINAL
C
C	COMMAND SEQUENCES TO RESTORE TERMINAL TO NOMINAL OPERATION MODE
C
	WRITE(*,1) (VTERM(I,ITERM),I=1, VTERM(7,ITERM))
	IMODE=0				! TERMINAL MODE
	IF (ITERM.EQ.3) WRITE(*,1) (VTERM(I,ITERM),I=1,6)	! VT240
	IF (ITERM.EQ.6) WRITE(*,1) ESC,37,33,49	! SELECT ANSI MODE FOR TEK4107
	GOTO 99
	END
C
C
	SUBROUTINE PLOTVT(XA,YA,IA)
C
C	PLOT TO TERMINAL GRAPHICS SCREEN
C	USING VTPLOT VECTOR STRING LINE PLOTTING SUBROUTINE
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C
C XA	X COORDINATE
C YA	Y COORDINATE
C IA	PEN CONTROL
C     +999   END PLOTTING
C      +11   END PLOTTING
C	+9   ERASE TO (XA,YA) PEN DOWN
C	+5   PEN UP AT CURRENT POINT
C	+4   SET UPPER RIGHT CORNER OF VIEW PORT
C	+3   MOVE TO (XA,YA) PEN UP
C	+2   MOVE TO (XA,YA) PEN DOWN
C	 0   CLEAR SCREEN WHEN XA < 0
C	     SET PEN COLOR WHEN XA >= 0 AND XA < 999
C	     SET TO XOR (NOT AVAILABLE ON ALL DEVICES) WHEN XA=999
C	     SET RELATIVE ROTATION ANGLE TO YA WHEN XA >= 0
C	-2   MOVE TO (XA,YA) PEN DOWN SET ORIGIN TO (XA,YA)
C	-3   MOVE TO (XA,YA) PEN UP   SET ORIGIN TO (XA,YA)
C	-4   SET LOWER LEFT CORNER OF VIEW PORT
C	-9   ERASE TO (XA,YA) PEN DOWN SET ORIGIN TO (XA,YA)
C
C	ANY OTHER VALUE OF IA IS TREATED AS A NOP
C
	INTEGER IC0(12),IV(2)
	REAL AV(2),XVS(2)
	LOGICAL PEN
C
	COMMON/VT100/IVT100,IMV(32),VRE(2),VOX,VOY,VSF,NIMV,VANG,ITERM,
     $		VVP(4),MV,MVW,IVCOL,IXLIM,IYLIM,IYREV,VLIM(2)
C
C	EQUIVALENCES ARE USED ONLY FOR CONVENIENCE
C
	EQUIVALENCE(AV(1),AV1),(AV(2),AV2),(XVS(1),XV2),(XVS(2),YV2)
	EQUIVALENCE(IV(1),IV1),(IV(2),IV2)
	DATA NC0/12/,IC0/2,3,0,-2,-3,5,11,9,-4,4,999,-9/
	DATA PEN/.FALSE./	! START PEN UP
	DATA IE/0/		! PEN TYPE (XOR,ERASE,WRITE) DEF=WRITE
C
	IF (IVT100.LE.0) RETURN
	I0=IA
	TANG=VANG*.017453294
	AV1=XA*COS(TANG)-YA*SIN(TANG)
	AV2=XA*SIN(TANG)+YA*COS(TANG)
	AV1=VSF*AV1+VOX
	AV2=VSF*AV2+VOY
C
C	DECODE INPUT COMMAND
C
	DO 30 I1=1,NC0
		IF (I0.EQ.IC0(I1)) GOTO 40
30	CONTINUE
	GOTO 800
40	GOTO(100,100,75,100,100,50,50,100,70,70,50,100),I1
C
C	PEN UP IN PLACE AND TERMINAE PLOTTING COMMANDS
C
50	CONTINUE				! FINISH UP LAST BUFFER
	IF (.NOT.PEN.OR.NIMV.EQ.0) GOTO 60	! EMPTY BUFFER?
	CALL VTPLOT(NIMV,IMV,IE,MVW)		! PLOT IT
60	CONTINUE
	IF (I0.EQ.11.OR.I0.EQ.999) THEN
		CALL CTERM(1)			! RESTORE TERMINAL TO TEXT MODE
		CALL CTERM(8)			! DE-INITIALIZE GRAPHICS
		IVT100=-1			! DISABLE TERMINAL GRAPHICS
	ENDIF
	IF (NIMV.GT.1) THEN
		NIMV1=2*NIMV-1
		IMV(1)=IMV(NIMV1)
		IMV(2)=IMV(NIMV1+1)
		NIMV=1
	ENDIF
	PEN=.FALSE.
	RETURN
C
C	CHANGE VIEWPORT VALUES
C
70	CONTINUE
	AV1=AV1/VRE(1)
	AV2=AV2/VRE(2)
C
C	INSURE VIEWPORT VALUES DO NOT EXCEED HARDWARE WINDOW LIMITS
C
	IF (AV1.LT.0.0) AV1=0.0
	IF (AV1.GT.VLIM(1)) AV1=VLIM(1)
	IF (AV2.LT.0.0) AV1=0.0
	IF (AV2.GT.VLIM(2)) AV2=VLIM(2)
C
	IF (I0.GT.0) THEN
		VVP(3)=AV1
		VVP(4)=AV2
	ELSE
		VVP(1)=AV1
		VVP(2)=AV2
	ENDIF
	RETURN
C
C	CHANGE COLOR/CLEAR SCREEN
C
75	CONTINUE
	IF (XA.GE.0.) GOTO 80
C
C	CLEAR SCREEN AND PEN UP
C
	CALL CTERM(-3)
	PEN=.FALSE.
	NIMV=1
	IMV(1)=0
	IMV(2)=0
	RETURN
80	IF (PEN) CALL VTPLOT(NIMV,IMV,IE,MVW)	! PLOT LAST BUFFER
	IE=0
	IF (XA.NE.999.) THEN
		IVCOL=IFIX(XA)
		CALL NEWVCOL(IVCOL)	! CHANGE LINE COLOR
		IF (IVCOL.EQ.0) IE=2	! SET ERASE FLAG
	ELSE
		IE=1			! SET XOR LINE MODE
	ENDIF
	VANG=VANG+YA			! PLOT ANGLE
	NIMV1=2*NIMV+1
	IMV(1)=IMV(NIMV1)
	IMV(2)=IMV(NIMV1+1)
	NIMV=1
	PEN=.FALSE.
	RETURN
C
C	PEN MOTION COMMAND
C
100	CONTINUE			! MOVE PEN
	IF (IA.GT.0) GOTO 200
	VOX=AV1
	VOY=AV2
200	CONTINUE
	I0=IABS(I0)
	IF (I0.EQ.9) THEN
		IF (PEN) CALL VTPLOT(NIMV,IMV,IE,MVW)	! PLOT LAST BUFFER
		NIMV1=2*NIMV+1
		IMV(1)=IMV(NIMV1)
		IMV(2)=IMV(NIMV1+1)
		NIMV=1
		PEN=.FALSE.
	ENDIF
	XM=VVP(1)*VRE(1)
	YM=VVP(2)*VRE(2)
	XX=VVP(3)*VRE(1)
	YX=VVP(4)*VRE(2)
C
C	GET CLIP FLAGS
C
	IVTA=IPCLIP(AV1,AV2,XM,YM,XX,YX)
	IVTB=IPCLIP(X0,Y0,XM,YM,XX,YX)
	XV2=AV1
	YV2=AV2
	IF (IOR(IVTA,IVTB).EQ.0) GOTO 220	! LINE VISIBLE
	IF (IAND(IVTA,IVTB).NE.0) THEN		! LINE INVISIBLE
		I0=3
		GOTO 250
	ENDIF
C
C CLIP LINE
C
210	CONTINUE
	IF (IVTB.NE.0) THEN			! OLD POINT IS OUTSIDE WINDOW
		XV2=X0
		YV2=Y0
		IF (PEN) THEN
			CALL VTPLOT(NIMV,IMV,IE,MVW)
			NIMV=0
			PEN=.FALSE.
		ENDIF
		CALL CLPIT(IVTB,XV2,YV2,AV1,AV2,XM,YM,XX,YX)
		IF (IVTB.NE.0) THEN
			I0=3
			NIMV=0
			X0=AV1
			Y0=AV2
			PEN=.FALSE.
			RETURN
		ENDIF
		IF (I0.EQ.2.OR.I0.EQ.9) THEN
			DO 205 I1=1,2
				T=XVS(I1)/VRE(I1)
				IF (T.LT.0.0) T=0.0
				IF (T.GT.VLIM(I1)) T=VLIM(I1)
				IV(I1)=T
205			CONTINUE
			IF (IYREV.EQ.1) IV(2)=IYLIM-IV(2)
			NIMV=1
			IMV(1)=IV(1)
			IMV(2)=IV(2)
			PEN=.TRUE.
		ENDIF
	ENDIF
	XV=AV1
	YV=AV2
	IF (IVTA.NE.0) CALL CLPIT(IVTA,XV,YV,X0,Y0,XM,YM,XX,YX)
	IF (IVTA.NE.0) THEN
		IF (PEN) THEN
			CALL VTPLOT(NIMV,IMV,IE,MVW)
			PEN=.FALSE.
		ENDIF
		I0=3
		NIMV=0
		X0=AV1
		Y0=AV2
		RETURN
	ENDIF
	XV2=XV
	YV2=YV
C
220	DO 710 I1=1,2
		T=XVS(I1)/VRE(I1)
		IF (T.LT.0.0) T=0.0
		IF (T.GT.VLIM(I1)) T=VLIM(I1)
		IV(I1)=T
710	CONTINUE
	IF (IYREV.EQ.1) IV(2)=IYLIM-IV(2) 		! MOVE ORIGIN
250	X0=AV1
	Y0=AV2
	IF (I0.EQ.2) GOTO 500
	IF (.NOT.PEN) GOTO 400
	IF (I0.EQ.9) THEN
		CALL VTPLOT(NIMV,IMV,2,MVW)
	ELSE
		CALL VTPLOT(NIMV,IMV,IE,MVW)
	ENDIF
400	IMV(1)=IV(1)
	IMV(2)=IV(2)
	NIMV=1
	PEN=.FALSE.
	RETURN
450	IMV(3)=IV(1)
	IMV(4)=IV(2)
	NIMV=2
	PEN=.TRUE.
	RETURN
500	CONTINUE			! PEN DOWN MOVEMENT
	IF (.NOT.PEN) GOTO 450
	PEN=.TRUE.
	NIMV1=2*NIMV+1
	IF (NIMV1.LT.33) GOTO 550
	CALL VTPLOT(NIMV,IMV,IE,MVW)
	IMV(1)=IMV(31)
	IMV(2)=IMV(32)
	NIMV=1
	NIMV1=3
550	IMV(NIMV1)=IV(1)
	IMV(NIMV1+1)=IV(2)
	NIMV=NIMV+1
800	RETURN
	END
C
C
	SUBROUTINE CLPIT(IVTB,XV2,YV2,AV1,AV2,XM,YM,XX,YX)
C
C	CLIPS A LINE SEGMENT PARTIALY VISIBLE
C
	IF (IAND(IVTB,1).NE.0) THEN	! LEFT EDGE
		YV2=YV2+(AV2-YV2)*(XM-XV2)/(AV1-XV2)
		XV2=XM
		IVTB=IPCLIP(XV2,YV2,XM,YM,XX,YX)
	ENDIF
	IF (IAND(IVTB,2).NE.0) THEN	! RIGHT EDGE
		YV2=YV2+(AV2-YV2)*(XX-XV2)/(AV1-XV2)
		XV2=XX
		IVTB=IPCLIP(XV2,YV2,XM,YM,XX,YX)
	ENDIF
	IF (IAND(IVTB,4).NE.0) THEN	! BOTTOM EDGE
		XV2=XV2+(AV1-XV2)*(YM-YV2)/(AV2-YV2)
		YV2=YM
		IVTB=IPCLIP(XV2,YV2,XM,YM,XX,YX)
	ENDIF
	IF (IAND(IVTB,8).NE.0) THEN	! TOP EDGE
		XV2=XV2+(AV1-XV2)*(YX-YV2)/(AV2-YV2)
		YV2=YX
		IVTB=IPCLIP(XV2,YV2,XM,YM,XX,YX)
	ENDIF
	RETURN
	END
C
C
	SUBROUTINE RTERM(IX)
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C	CLEARS RAMTEK SCREEN -- SIMILAR TO CTERM
C
C IX	CONTROL FLAG
C	= 0 CLEAR RAMTEK SCREEN
C	= 2 ASK IF RAMTEK SCREEN CLEAR
C	=-2 CLEAR RAMTEK SCREEN
C	=-4 CLEAR RAMTEK SCREEN
C	= 3 CLOSE RAMTEK CHANNEL
C	=-3 REOPEN CLOSED RAMTEK CHANNEL
C
	COMMON/RMTEK/ICHAN,IMR(128),RRE(2),ROX,ROY,RSF,NIMR,RANG,MM,IPW,
     $		IPSC,ICOL,RVP(4),IRID,RLIM(2),IRXLIM,IRYLIM,IDDEV
C
	CHARACTER*1 ANS
C
	IF (ICHAN.EQ.-99.AND.IX.EQ.2) GOTO 80
	IF (ICHAN.EQ.-99.AND.IX.EQ.-3) GOTO 80
	IF (ICHAN.LE.0) RETURN
	IF (IABS(IX).GT.4) RETURN
	GOTO (10,15,10,15,10,15,20,30,15),IX+5
10	CONTINUE			! CLEAR RAMTEK SCREEN
	CALL RMCLEAR(ICHAN,IERR)
15	RETURN
20	WRITE(*,5)			! ASK IF SCREEN CLEAR
5	FORMAT('$Clear Ramtek Screen? (y/n) [y] ')
	READ(*,6) ANS
6	FORMAT(A1)
	IANS=ICHAR(ANS)
	IF (IANS.GE.96) IANS=IANS-32
	IF (IANS.EQ.89.OR.IANS.EQ.32) THEN
		GOTO 10
	ELSE
		IF (IANS.EQ.81) GOTO 30 ! TEMP. CLOSE CHANNEL
		IF (IANS.EQ.83) THEN
			CALL RAMCLOSE(ICHAN)
			ICHAN=-99  		! SKIP PLOT MODE
		ENDIF
	ENDIF
	RETURN
30	CONTINUE				! TEMP. CLOSE CHANNEL
	CALL RAMCLOSE(ICHAN)
	ICHAN=-99
	RETURN
80	CONTINUE
	CALL RAMOPEN(ICHAN,IRID,IDDEV,IERR)
	IF (ICHAN.LT.0) WRITE(*,1)
1	FORMAT(' *** ERROR *** CAN NOT REOPEN RAMTEK CHANNEL')
	RETURN
	END
C
C
	SUBROUTINE PPLOT(XA,YA,IA)
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C	EXTENSIVELY MODIFIED FROM CERRITOS ORIGINAL
C
C	PLOT TO PRINTER GRAPHICS FILE
C
C XA	X COORDINATE
C YA	Y COORDINATE
C IA	PEN CONTROL
C	+999 END OF PLOTS
C	+11  END OF PLOTS
C	+10  EJECT PAGE
C	+9   MOVE TO (XA,YA) ERASE
C	+3   MOVE TO (XA,YA) PEN UP
C	+5   PEN UP AT CURRENT LOCATION
C	+4   SET UPPER RIGHT CORNER OF VIEW PORT
C	+2   MOVE TO (XA,YA) PEN DOWN
C	 0   CHANGE RELATIVE ROTATION ANGLE TO YA IF XA >= 0
C	     CHANGE PLOTTING COLOR TO XA IF XA >= 0
C	-2   MOVE TO (XA,YA) PEN DOWN SET ORIGIN TO (XA,YA)
C	-3   MOVE TO (XA,YA) PEN UP   SET ORIGIN TO (XA,YA)
C	-4   SET LOWER LEFT CORNER OF VIEW PORT
C	-9   MOVE TO (XA,YA) ERASE    SET ORIGIN TO (XA,YA)
C
C	ANY OTHER VALUE OF IA IS TREATED AS A NOP
C
	INTEGER IV(2),IC0(13)
	REAL AV(2),XVS(2),ALIM(2),ALIM1,ALIM2
C
	COMMON/PXPCOM/LU,MP,RE(2),OX,OY,SF,PX,PY,MX,MW,MCOL,MSC,
     $		PANG,PVP(4)
C
C	EQUIVALENCES ARE USED ONLY FOR CONVENIENCE
C
	EQUIVALENCE (AV(1),AV1),(AV(2),AV2)
	EQUIVALENCE (XVS(1),XV2),(XVS(2),YV2)
	EQUIVALENCE (IV(1),IV1),(IV(2),IV2)
	EQUIVALENCE (ALIM1,ALIM(1)),(ALIM2,ALIM(2))
C
C	META FILE LIMITS ON X AN Y IN INCHES
C
	DATA ALIM/56.5,56.5/
C
	DATA NC0/13/,IC0/2,3,0,-2,-3,5,9,-9,10,11,999,4,-4/
C
	IF (LU.LE.0) RETURN
	I0=IA
	TANG=PANG*.0174532
	AV1=XA*COS(TANG)-YA*SIN(TANG)
	AV2=XA*SIN(TANG)+YA*COS(TANG)
	AV1=SF*AV1+OX
	AV2=SF*AV2+OY
C
C	DECODE COMMAND
C
	DO 30 I1=1,NC0
		IF (I0.EQ.IC0(I1)) GOTO 40
30	CONTINUE
	RETURN
40	CONTINUE
	GOTO (100,100,50,100,100,910,100,100,715,900,900,70,70),I1
50	CONTINUE
C
C	CHANGE COLOR TO XA, PLOTTING ANGLE BY YA
C
	IF (XA.GE.0) THEN
		PANG=PANG+YA
C
C	CHANGE PLOT COLOR
C
		MCOL=XA
		CALL PPLOTP(MW,MCOL,1002)
	ENDIF
	RETURN
70	CONTINUE
	IF (AV1.LT.0.0) AV1=0.0
	IF (AV1.GT.ALIM1) AV1=ALIM1
	IF (AV2.LT.0.0) AV2=0.0
	IF (AV2.GT.ALIM2) AV2=ALIM2
	IF (I0.GT.0) THEN
		PVP(3)=AV1
		PVP(4)=AV2
	ELSE
		PVP(1)=AV1
		PVP(2)=AV2
	ENDIF
	RETURN
100	CONTINUE
	IF (IA.LE.0) THEN
		OX=AV1
		OY=AV2
	ENDIF
	I0=IABS(I0)
	XM=PVP(1)
	YM=PVP(2)
	XX=PVP(3)
	YX=PVP(4)
	IVTA=IPCLIP(AV1,AV2,XM,YM,XX,YX)
	IVTB=IPCLIP(PX,PY,XM,YM,XX,YX)
	IF (IOR(IVTA,IVTB).EQ.0) GOTO 705	! LINE ENTIRELY VISIBLE	
	IF (IAND(IVTA,IVTB).NE.0) THEN		! LINE ENTIRELY INVISIBLE
		PX=AV1
		PY=AV2
		RETURN
	ENDIF
	IF (IVTB.NE.0) THEN			! OLD POINT IS OUTSIDE WINDOW
		XV2=PX
		YV2=PY
		CALL CLPIT(IVTB,XV2,YV2,AV1,AV2,XM,YM,XX,YX)
		IF (IVTB.NE.0) THEN		! VECTOR DOES NOT INTERSECT
			PX=AV1
			PY=AV2
			RETURN
		ENDIF
		DO 701 I1=1,2
			IF (XVS(I1).LT.0.0) XVS(I1)=0.0
			IF (XVS(I1).GT.ALIM(I1)) XVS(I1)=ALIM(I1)
			T=XVS(I1)/RE(I1)
			IV(I1)=T
701		CONTINUE
		CALL PPLOTP(IV2,IV1,3)
	ENDIF
	XV=AV1
	YV=AV2
	IF (IVTA.NE.0) CALL CLPIT(IVTA,XV,YV,PX,PY,XM,YM,XX,YX)
	IF (IVTA.NE.0) THEN
		PX=AV1
		PY=AV2
		RETURN
	ENDIF
	PX=AV1
	PY=AV2
	AV1=XV
	AV2=YV
	GOTO 715
705	PX=AV1
	PY=AV2
715	DO 720 I1=1,2
		IF (AV(I1).LT.0.0) AV(I1)=0.0
		IF (AV(I1).GT.ALIM(I1)) AV(I1)=ALIM(I1)
		T=AV(I1)/RE(I1)
		IV(I1)=T
720	CONTINUE
	CALL PPLOTP(IV2,IV1,I0)
	RETURN
900	CONTINUE			! I0=999 OR I0=11 END PLOTS
	I0=11
	GOTO 715
910	CONTINUE
	I0=3
	AV1=PX
	AV2=PY
	GOTO 715
	END
C
	SUBROUTINE PLOTRM(XA,YA,IA)
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C	PLOT TO RAMTEK USING RMPLOT VECTOR STRING LINE PLOTTING ROUTINE
C
C XA	X COORDINATE
C YA	Y COORDINATE
C IA	PEN CONTROL
C     +999   END PLOTTING
C      +11   END PLOTTING
C	+9   ERASE TO (XA,YA) PEN DOWN (ERASE COLOR IS 0)
C	+5   PEN UP AT CURRENT POSITION
C	+4   SET UPPER RIGHT CORNER OF VIEW PORT
C	+3   MOVE TO (XA,YA) PEN UP
C	+2   MOVE TO (XA,YA) PEN DOWN
C	 0   CLEAR SCREEN WHEN XA < 0
C	     XA >= CHANGE COLOR TABLE VALUE USED FOR PLOTTING TO XA
C	     RELATIVE ROTATION ANGLE SET TO YA WHEN XA >= 0
C	-2   MOVE TO (XA,YA) PEN DOWN SET ORIGIN TO (XA,YA)
C	-3   MOVE TO (XA,YA) PEN UP   SET ORIGIN TO (XA,YA)
C	-4   SET LOWER RIGHT CORNER OF VIEW PORT
C	-9   ERASE TO (XA,YA) PEN DOWN (ERASE COLOR IS 0) SET ORIGIN
C		TO (XA,YA)
C
C	ANY OTHER VALUE OF IA IS TREATED AS A NOP
C
	INTEGER IC0(12),IV(2)
	REAL AV(2),ALIM(2),XVS(2)
	LOGICAL PEN
C
	COMMON/RMTEK/ICHAN,IMR(128),RRE(2),ROX,ROY,RSF,NIMR,RANG,MM,IPW,
     $		IPSC,ICOL,RVP(4),IRID,RLIM(2),IRXLIM,IRYLIM,IDDEV
C
C	EQUIVALENCES ARE USED ONLY FOR CONVENIENCE
C
	EQUIVALENCE(AV(1),AV1),(AV(2),AV2),(XVS(1),XV2),(XVS(2),YV2)
	EQUIVALENCE(IV(1),IV1),(IV(2),IV2)
	DATA NC0/12/,IC0/2,3,0,-2,-3,5,11,9,-9,4,-4,999/
	DATA ICOL0/0/			! ERASE COLOR
	DATA PEN/.FALSE./		! PEN UP FLAG
C
	IF (ICHAN.LE.0) RETURN
	I0=IA
	TANG=RANG*.0174532
	AV1=XA*COS(TANG)-YA*SIN(TANG)
	AV2=XA*SIN(TANG)+YA*COS(TANG)
	AV1=RSF*AV1+ROX
	AV2=RSF*AV2+ROY
C
C	DECODE COMMAND
C
	DO 30 I1=1,NC0
		IF (I0.EQ.IC0(I1)) GOTO 40
30	CONTINUE
	GOTO 800
40	CONTINUE
	GOTO(100,100,75,100,100,50,50,80,80,70,70,50),I1
50	CONTINUE				! FINISH UP LAST BUFFER
	IF (.NOT.PEN.OR.NIMR.EQ.0) GOTO 60	! EMPTY BUFFER
	CALL RMPLOT(ICHAN,NIMR,IMR,ICOL,IERR)	! PLOT IT
60	IF (I0.NE.5) CALL RAMCLOSE(ICHAN)	! CLOSE RAM TEK CHANNEL
	IF (NIMR.GT.1) THEN
		NIMR1=2*NIMR-1
		IMR(1)=IMR(NIMR1)
		IMR(2)=IMR(NIMR1+1)
		NIMR=1
	ENDIF
	PEN=.FALSE.
	RETURN
70	AV1=AV1/RRE(1)
	AV2=AV2/RRE(2)
	IF (AV1.LT.0.0) AV1=0.0
	IF (AV1.GT.RLIM(1)) AV1=RLIM(1)
	IF (AV2.LT.0.0) AV1=0.0
	IF (AV2.GT.RLIM(2)) AV2=RLIM(2)
	IF (I0.GT.0) THEN
		RVP(3)=AV1
		RVP(4)=AV2
	ELSE
		RVP(1)=AV1
		RVP(2)=AV2
	ENDIF
	RETURN
75	CONTINUE			! CHANGE COLOR TABLE VALUE
	IF (XA.GE.0.) GOTO 80
	CALL RMCLEAR(ICHAN,IERR)	! CLEAR RAM TEK SCREEN
	PEN=.FALSE.
	NIMR=1
	IMR(1)=0
	IMR(2)=0
	RETURN
80	IF (.NOT.PEN) GOTO 90
	CALL RMPLOT(ICHAN,NIMR,IMR,ICOL,IERR)! PLOT LAST BUFFER
	NIMR1=2*NIMR+1
	IMR(1)=IMR(NIMR1)
	IMR(2)=IMR(NIMR1+1)
	NIMR=1
90	CONTINUE	
	IF (I0.EQ.9) THEN		! ERASE LINE
		PEN=.TRUE.
		GOTO 100
	ENDIF
	RANG=RANG+YA
	IF (XA.LT.1024.) ICOL=XA
	IF (ICOL.LT.0) ICOL=0
	PEN=.FALSE.			! PEN UP
	RETURN
100	CONTINUE			! MOVE PEN
	IF (IA.GT.0) GOTO 200
	ROX=AV1
	ROY=AV2
200	CONTINUE
	I0=IABS(I0)
	XM=RVP(1)*RRE(1)
	YM=RVP(2)*RRE(2)
	XX=RVP(3)*RRE(1)
	YX=RVP(4)*RRE(2)
	IVTA=IPCLIP(AV1,AV2,XM,YM,XX,YX)
	IVTB=IPCLIP(X0,Y0,XM,YM,XX,YX)
	XV2=AV1
	YV2=AV2
	IF (IOR(IVTA,IVTB).EQ.0) GOTO 220	! LINE VISIBLE
	IF (IAND(IVTA,IVTB).NE.0) THEN		! LINE INVISIBLE
		I0=3
		GOTO 250
	ENDIF
C
C CLIP LINE
C
210	CONTINUE
	IF (IVTB.NE.0) THEN			! OLD POINT IS OUTSIDE WINDOW
		XV2=X0
		YV2=Y0
		IF (PEN) THEN
			CALL RMPLOT(ICHAN,NIMR,IMR,ICOL,IERR)! PLOT LAST BUFFER
			NIMR=0
			PEN=.FALSE.
		ENDIF
		CALL CLPIT(IVTB,XV2,YV2,AV1,AV2,XM,YM,XX,YX)
		IF (IVTB.NE.0) THEN
			I0=3
			NIMR=0
			X0=AV1
			Y0=AV2
			PEN=.FALSE.
			RETURN
		ENDIF
		IF (I0.EQ.2.OR.I0.EQ.9) THEN
			DO 205 I1=1,2
				T=XVS(I1)/RRE(I1)
				IF (T.LT.0.0) T=0.0
				IF (T.GT.RLIM(I1)) T=RLIM(I1)
				IV(I1)=T
205			CONTINUE
			IV(2)=IRYLIM-IV(2)
			NIMR=1
			IMR(1)=IV(1)
			IMR(2)=IV(2)
			PEN=.TRUE.
		ENDIF
	ENDIF
	XV=AV1
	YV=AV2
	IF (IVTA.NE.0) CALL CLPIT(IVTA,XV,YV,X0,Y0,XM,YM,XX,YX)
	IF (IVTA.NE.0) THEN
		IF (PEN) THEN
			CALL RMPLOT(ICHAN,NIMR,IMR,ICOL,IERR)! PLOT LAST BUFFER
			PEN=.FALSE.
		ENDIF
		I0=3
		NIMR=0
		X0=AV1
		Y0=AV2
		RETURN
	ENDIF
	XV2=XV
	YV2=YV
C
220	DO 710 I1=1,2
		T=XVS(I1)/RRE(I1)
		IF (T.LT.0.0) T=0.0
		IF (T.GT.RLIM(I1)) T=RLIM(I1)
		IV(I1)=T
710	CONTINUE
	IV(2)=IRYLIM-IV(2) 		! MOVE ORIGIN
250	X0=AV1
	Y0=AV2
	IF (I0.EQ.2) GOTO 500
	IF (.NOT.PEN) GOTO 400
	IF (I0.NE.9) THEN
		CALL RMPLOT(ICHAN,NIMR,IMR,ICOL,IERR)! PLOT LAST BUFFER
	ELSE
		IMR(3)=IV(1)
		IMR(4)=IV(2)
		CALL RMPLOT(ICHAN,2,IMR,ICOL0,IERR)! PLOT ERASE LINE
	ENDIF
400	IMR(1)=IV(1)
	IMR(2)=IV(2)
	NIMR=1
	PEN=.FALSE.
	RETURN
450	IMR(3)=IV(1)
	IMR(4)=IV(2)
	NIMR=2
	PEN=.TRUE.
	RETURN
500	CONTINUE			! PEN DOWN MOVEMENT
	IF (.NOT.PEN) GOTO 450
	PEN=.TRUE.
	NIMR1=2*NIMR+1
	IF (NIMR1.LT.129) GOTO 550
	CALL RMPLOT(ICHAN,NIMR,IMR,ICOL,IERR)! PLOT BUFFER
	IMR(1)=IMR(127)
	IMR(2)=IMR(128)
	NIMR=1
	NIMR1=3
550	IMR(NIMR1)=IV(1)
	IMR(NIMR1+1)=IV(2)
	NIMR=NIMR+1
800	RETURN
	END
C
C
	INTEGER FUNCTION IPCLIP(X,Y,XM,YM,XX,YX)
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C	CHECKS TO SEE IF POINT XY IS IN RECTANGLE (XM,YM)-(XX,YX)
C	RETURNS ZERO IF IT IS
C
	INTEGER CD
	CD=0
	IF (X.LT.XM) THEN
		CD=1
	ELSE
		IF (X.GT.XX) CD=2
	ENDIF
	IF (Y.LT.YM) THEN
		CD=CD+4
	ELSE
		IF (Y.GT.YX) CD=CD+8
	ENDIF
	IPCLIP=CD
	RETURN
	END
C
C
	SUBROUTINE RPLOTS(ID,VPX,VPY,ZOM)
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C
C	THIS ROUTINE INTIALIZES THE RAMTEK GRAPHICS DEVICE
C ID	SCREEN CONTROL
C	<= 0 CLEAR SCREEN
C
	COMMON/RMTEK/ICHAN,IMR(128),RRE(2),ROX,ROY,RSF,NIMR,RANG,MM,IPW,
     $		IPSC,ICOL,RVP(4),IRID,RLIM(2),IRXLIM,IRYLIM,IDDEV
C
	IRID=1					! NORMAL RAMTEK
	IF (ZOM.LT.0.0) IRID=2			! SPECIAL RAMTEK
	CALL RAMOPEN(ICHAN,IRID,IDDEV,IERR)	! OPEN RAMTEK CHANNEL
	IF (ICHAN.LT.0.OR.IERR.NE.0) THEN	! RAMTEK NOT AVAILABLE
		WRITE (*,1)
1		FORMAT(' *** RAMTEK CHANNEL NOT AVAILABLE ***')
		CALL EXIT
	ENDIF
	MM=0			! LINE TYPE
	IPW=1			! LINE WIDTH
	IPSC=0			! LINE TYPE SCALE FACTOR
	CALL RMTEXTURE(ICHAN,MM,IPW,IPSC,IERR) ! SET LINE TEXTURE
	NIMR=1			! RESET VECTOR BUFFTER
	IMR(1)=0		! ORIGIN VECTOR BUFFER
	IMR(2)=0		! ORIGIN VECTOR BUFFER
	ICOL=255		! DEFAULT COLOR TABLE VALUE
	ROX=VPX 		! X ORIGIN
	ROY=VPY 		! Y ORIGIN
	RSF=ABS(ZOM)		! SCALE RACTOR
	RANG=0.			! ROTATION
	IF (RSF.LE.0.0) RSF=1.0
	RRE(1)=1024.
	IF (IRID.EQ.2) RRE(1)=512.
	RLIM(1)=1279.
	IF (IRID.EQ.2) RLIM(1)=511.
	RLIM(2)=RRE(1)-1.
	IRXLIM=RLIM(1)
	IRYLIM=RLIM(2)
	RRE(1)=11./RRE(1)	! BIG RAM TEK RESOLUTION X (1024 PIXELS IN 11 INCHES)
	RRE(2)=RRE(1)		! RAM TEK RESOLUTION Y
	RVP(1)=0.0		! VIEW PORT PARAMETERS
	RVP(2)=0.0		! LOWER LEFT
	CALL PLOTRM(999.,999.,4)! UPPER RIGHT
	IF (ID.LE.0) CALL PLOTRM(-1.,0.,0)			! CLEAR SCREEN
	RETURN
	END
C
C
	INTEGER FUNCTION IRMCHAN(IDEV)
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C	RETURNS RAMTEK CHANNEL NUMBER IN CURRENT USE
C	A VALUE LESS THAN 1 INDICATES THAT CHANNEL IS NOT OPEN
C
C	OUTPUTS:
C	IDEV	(I)	RAMTEK DEVICE NUMBER
C
	COMMON/RMTEK/ICHAN,IMR(128),RRE(2),ROX,ROY,RSF,NIMR,RANG,MM,IPW,
     $		IPSC,ICOL,RVP(4),IRID,RLIM(2),IRXLIM,IRYLIM,IDDEV
	IRMCHAN=ICHAN
	IDEV=IDDEV
	RETURN
	END
C
	SUBROUTINE WHERERM(ORX,ORY,ZOM,ANG,RX,RY,NT,NS,ICOLOR,NCHAN)
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C	RETURNS PLOT INFO FROM RAMTEK
C
	COMMON/RMTEK/ICHAN,IMR(128),RRE(2),ROX,ROY,RSF,NIMR,RANG,MM,IPW,
     $		IPSC,ICOL,RVP(4),IRID,RLIM(2),IRXLIM,IRYLIM,IDDEV
C
	ORX=ROX				! X ORIGIN
	ORY=ROY				! Y ORIGIN
	ZOM=RSF				! ZOOM SCALE FACTOR
	ANG=RANG			! PLOTTING ANGLE
	IF (RSF.NE.0.0) RX=RRE(1)/RSF	! X DIRECTION RESOLUTION
	IF (RSF.NE.0.0) RY=RRE(2)/RSF	! Y DIRECTION RESOLUTION
	NT=MM				! LINE TYPE
	NS=IPW				! PIXEL SCALING OF LINE TYPE
	NCHAN=ICHAN			! CHANNEL NUMBER IF NCHAN > 0
	ICOLOR=ICOL			! CURRENT COLOR TABLE VALUE
	RETURN
	END
C
	SUBROUTINE WHEREVT(ORX,ORY,ZOM,ANG,RX,RY,NVT,ISEL,NT,NW,NCOL)
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C	RETURNS PLOT INFO FOR TERMINAL
C
	COMMON/VT100/IVT100,IMV(32),VRE(2),VOX,VOY,VSF,NIMV,VANG,ITERM,
     $		VVP(4),MV,MVW,IVCOL,IXLIM,IYLIM,IYREV,VLIM(2)
C
	ORX=VOX				! X ORIGIN
	ORY=VOY				! Y ORIGIN
	ZOM=VSF				! ZOOM SCALE FACTOR
	ANG=VANG			! PLOTTING ANGLE
	IF (VSF.NE.0.0) RX=VRE(1)/VSF	! X DIRECTION RESOLUTION
	IF (VSF.NE.0.0) RY=VRE(2)/VSF	! Y DIRECTION RESOLUTION
	NVT=IVT100			! NVT > 0 MEANS VT ENABLED
	ISEL=ITERM			! 0=SELNAR GR1000+ 1=GR100
	NT=MV				! LINE TYPE
	NW=MVW				! LINE WIDTH
	NCOL=IVCOL			! LINE COLOR
	RETURN
	END
C
	SUBROUTINE WHEREPR(ORX,ORY,AX,AY,ZOM,ANG,RX,RY,NVT,MXX,MWW,MCOLL)
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C	RETURNS PLOT INFO FROM PRINTER
C
	COMMON/PXPCOM/LU,MP,RE(2),OX,OY,SF,PX,PY,MX,MW,MCOL,MSC,
     $		PANG,PVP(4)
C
	ORX=OX				! X ORIGIN
	ORY=OY				! Y ORIGIN
	AX=PX				! LAST SCALED,SHIFTED X
	AY=PY				! LAST SCALED,SHIFTED Y
	ZOM=SF				! ZOOM SCALE FACTOR
	ANG=PANG			! PLOTTING ANGLE
	IF (SF.NE.0.0) RX=RE(1)/SF	! X DIRECTION RESOLUTION
	IF (SF.NE.0.0) RY=RE(2)/SF	! Y DIRECTION RESOLUTION
	NVT=LU				! NVT > 0 MEANS PR ENABLED
	MXX=MX				! LINE TYPE
	MWW=MW				! LINE WIDTH
	MCOLL=MCOL			! LINE COLOR
	RETURN
	END
C
	SUBROUTINE PLOT(XA,YA,I0)
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C	+ ADD CONTROL-C INTERRUPT
C	  NOTE: IF CONTROL-C CODE IS NOT USED, LINES MARKED WITH CONTROL-C
C	  CAN BE COMMENTED OUT.
C
C	BASIC SUBROUTINE FOR PLOTTING TO ALL DEVICES
C
	COMMON/LSTPLT/XLAST,YLAST,I0LAST
	COMMON/ASTC/IASTFL,IASTPL			! CONTROL-C
C
	IASTPL=1					! CONTROL-C
	CALL PPLOT (XA,YA,I0)
	CALL PLOTRM(XA,YA,I0)
	CALL PLOTVT(XA,YA,I0)
	XLAST=XA
	YLAST=YA
	I0LAST=I0
	IASTPL=0					! CONTROL-C
	IF (IASTFL.NE.0) CALL ASTINTER(IASTFL)	! CONTROL-C
	RETURN
	END
C
C
	SUBROUTINE PFACTOR(SC)
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C	CHANGE SCALE FACTOR ON PRINTER
C
C	SC	(R)	SCALE FACTOR
C
	COMMON/PXPCOM/LU,MP,RE(2),OX,OY,SF,PX,PY,MX,MW,MCOL,MSC,
     $		PANG,PVP(4)
	IF (SC.GT.0.) SF=SC*SF
	IF (SC.LE.0.) SF=1.
	RETURN
	END
C
	SUBROUTINE RFACTOR(SC)
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C
C	CHANGE SCALE FACTOR ON RAMTEK DISPLAY
C
	COMMON/RMTEK/ICHAN,IMR(128),RRE(2),ROX,ROY,RSF,NIMR,RANG,MM,IPW,
     $		IPSC,ICOL,RVP(4),IRID,RLIM(2),IRXLIM,IRYLIM,IDDEV
	IF (SC.GT.0.) RSF=RSF*SC
	IF (SC.LE.0.) RSF=1.
	RETURN
	END
C
	SUBROUTINE VFACTOR(SC)
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C
C	CHANGE SCALE FACTOR FOR TERMINAL PLOTTING
C
	COMMON/VT100/IVT100,IMV(32),VRE(2),VOX,VOY,VSF,NIMV,VANG,ITERM,
     $		VVP(4),MV,MVW,IVCOL,IXLIM,IYLIM,IYREV,VLIM(2)
	IF (SC.GT.0.) VSF=VSF*SC
	IF (SC.LE.0.) VSF=1.
	RETURN
	END
C
C
	SUBROUTINE PPLOTP(M0,M1,M2)
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C	WRITE PLOTTING DATA TO META FILE
C
C M0	WORD 1 OF OUTPUT
C M1	WORD 2 OF OUTPUT
C M2	WORD 3 OF OUTPUT (COMMAND WORD)
C
C	LONGLIB META FILE FORMAT
C
C	M0	M1	M2	COMMAND INTERPRETATION
C
C	X	Y	2	PEN DOWN MOVE
C	X	Y	3	PEN UP MOVE
C	X	Y	-2*	PEN DOWN MOVE WITH NEW ORIGIN
C	X	Y	-3*	PEN UP MOVE WITH NEW ORIGIN
C	X	Y	9	PEN ERASE MOVE
C	X	Y	-9*	PEN ERASE WITH NEW ORIGIN
C	X	Y	10	NEW PAGE
C	-	-	11	END OF FILE
C	-	-	999	END OF FILE
C	RESX	RESY	1000	SET RESOLUTION
C	TYPE	SCALE	1001	SET LINE TYPE
C	-	COLOR	1002	SET PEN COLOR
C	WIDTH	-	1003	SET LINE WIDTH
C	-	-	(ELSE*)	INVALID COMMAND
C
C	* NORMALLY NOT SENT TO FILE
C
C	FIRST COMMAND IN FILE SHOULD SET RESOLUTION
C	NEXT COMMANDS SHOULD SET LINE TYPE, WIDTH AND COLOR
C
	INTEGER*2 MB(128)		! OUTPUT RECORD BUFFER
C
	COMMON/PXPCOM/LU,MP,RE(2),OX,OY,SF,PX,PY,MX,MW,MCOL,MSC,
     $		PANG,PVP(4)
C
	IF (LU.LE.0) RETURN			! NO PRINT FLAG
	IF (MP.LT.0) GOTO 20			! CHECK FOR FILE CLOSED
	MP=3+MP					! INCREMENT POINTER
	IF (MP.LT.128) GOTO 10			! CHECK FOR FULL BUFFER
	WRITE (LU) MB				! WRITE RECORD
	MP=3
10	MB(MP)=M2				! STORE DATA
	MB(MP-1)=M1
	MB(MP-2)=M0
	IF (M2.NE.11.AND.M2.NE.999) GOTO 20	! CHECK FOR END OF PLOTS
	WRITE (LU) MB				! WRITE LAST RECORD
	CLOSE (LU)				! CLOSE FILE
	MP=-1					! FLAG END OF PLOTS
20	RETURN
	END
C
C
	SUBROUTINE PPLOTS(IA,X0,Y0,ZOM)
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C	INITIALIZE PRINTER HISTORY FILE GRAPHICS PACKAGE
C
C IA	LOGICAL UNIT FOR OUTPUT
C	= 0   DEFAULTS TO 3
C	< 0  DOES NOT PRODUCE OUTPUT
C
	COMMON/PXPCOM/LU,MP,RE(2),OX,OY,SF,PX,PY,MX,MW,MCOL,MSC,
     $		PANG,PVP(4)
C
	LU=IA			! FORTRAN FILE NUMBER
	OX=X0			! ORIGIN X
	OY=Y0			! ORIGIN Y
	SF=ZOM			! SCALE FACTOR
	IF (SF.LE.0.0) SF=1.0
	PANG=0.0		! PLOTTING ANGLE ROTATION
	PX=0.0			! LAST POINT PLOTTED
	PY=0.0
	IR1=500			! PIXELS PER INCH RESOLUTION
	IR2=500
	RE(1)=1./FLOAT(IR1)	! RESOLUTION FOR META FILE
	RE(2)=1./FLOAT(IR2)
	PVP(1)=0.0		! VIEW PORT PARAMETERS LOWER LEFT
	PVP(2)=0.0
	CALL PPLOT(999.,999.,4)	! VIEW PORT UPPER RIGHT CORNER SET
	CALL PPLOT(-999.,-999.,-4)
	IF (LU.EQ.0) LU=3
	MP=0			! PRINT BUFFER COUNTER
	MX=0			! DEFAULT LINE TYPE (SOLID)
	MSC=1			! DEFAULT LINE SCALING (UNIT)
	MW=1			! DEFAULT LINE WIDTH (UNIT)
	MCOL=1			! DEFAULT LINE COLOR
	IF (LU.LT.0) RETURN
	CALL PPLOTP(IR2, IR1,1000)	! INITIALIZE RESOLUTION
	CALL PPLOTP(MX , MSC,1001)	! INITIALIZE LINE TYPE, SCALING
	CALL PPLOTP(MW ,MCOL,1002)	! INITIALIZE LINE COLOR
	CALL PPLOTP(MW ,   0,1003)	! INITIALIZE LINE WIDTH
	RETURN
	END
C
C
	SUBROUTINE PPEN(IP)
C
C	SELECT PRINTER PLOTTING LINE TYPE
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C
C IP	PEN CONTROL WORD (IP<0 RESETS LINE TYPE TO SOLID, 1 DOT WIDE)
C
C	UNITS DIGIT=LINE TYPE 0-9
C
C	TENS  DIGIT=LINE WIDTH
C	  0 = NO CHANGE
C	  1-7 WIDTH IN DOTS
C
C	HUNDREDS DIGIT=LINE TYPE SCALE FACTOR
C	  0 = NO CHANGE
C
	COMMON/PXPCOM/LU,MP,RE(2),OX,OY,SF,PX,PY,MX,MW,MCOL,MSC,
     $		PANG,PVP(4)
C
	IF (IP.LE.0) THEN
		M=0
		MW1=1
		MSC=1
		GOTO 10
	ENDIF
	MSC1=IP/100
	IF (MSC1.NE.0) MSC=MSC1
	MW1=MOD(IP,100)/10
	M=MOD(IP,10)
10	MX=M
C
	IF (LU.GT.0) THEN
C
C	CHANGE LINE TYPE AND SCALE
C
		CALL PPLOTP(MX,MSC,1001)
C
C	CHANGE PEN WIDTH
C
		IF (MW1.NE.0) THEN
			MW=MW1
			CALL PPLOTP(MW,0,1003)
		ENDIF
	ENDIF
	RETURN
	END
C
C
	SUBROUTINE RMPEN(IP)
C
C	MODIFY RAMTEK PLOTTING LINE TYPE
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C
C IP	PEN CONTROL WORD
C		NOTE: IP<0 RESET TO SOLID LINE, WIDTH 1
C
C	UNITS DIGIT=LINE TYPE 0-9
C
C	TENS  DIGIT=LINE WIDTH
C	  0 = NO CHANGE
C	  1-7 LINE WIDTH
C
C	HUNDREDS DIGIT=LINE TYPE SCALE FACTOR
C	  0 = NO CHANGE
C	  1-7 BIT PATTERN SCALE FACTOR
C
	COMMON/RMTEK/ICHAN,IMR(128),RRE(2),ROX,ROY,RSF,NIMR,RANG,MM,IPW,
     $		IPSC,ICOL,RVP(4),IRID,RLIM(2),IRXLIM,IRYLIM,IDDEV
C
	IF (IP.LE.0) THEN
		M=0
		IPW=1
		IPSC=0
		GOTO 10
	ENDIF
	IPSC1=IP/100
	IF (IPSC1.NE.0) IPSC=IPSC1-1
	IPW1=MOD(IP,100)/10
	IF (IPW1.GT.7) IPW1=7
	IF (IPW1.NE.0) IPW=IPW1
	M=MOD(IP,10)
10	MM=M
	CALL RMTEXTURE(ICHAN,MM,IPW,IPSC,IERR)
	RETURN
	END
C
	SUBROUTINE VPEN(IP)
C
C	CHANGE TERMINAL PLOTTING LINE TYPE
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C
C IP	PEN CONTROL WORD
C		NOTE: IP<0 IS RESET TO SOLID LINE UNIT WIDTH
C
C	UNITS DIGIT=LINE TYPE 0-9
C
C	TENS  DIGIT=LINE WIDTH
C	(0 = NO CHANGE)
C
C	HUNDREDS DIGIT=LINE TYPE SCALE FACTOR (NOT IMPLEMENTED)
C
	IF (IP.LE.0) THEN
		MV=0
		MVW=1
		GOTO 10
	ENDIF
	MVW1=MOD(IP,100)/10
	IF (MVW1.NE.0) MVW=MVW1
	MV=MOD(IP,10)
	MV=MAX(0,MV)
10	CONTINUE
C
C	CALL TERMINAL DEPENDENT ROUTINE TO CHANGE LINE TYPE
C
	CALL NEWVPEN(MV,MVW)
	RETURN
	END
C
	SUBROUTINE NEWPAGE
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C
C	THIS ROUTINE CAUSES A RESETING OF THE PRINTER PAGE WITHOUT
C	AFFECTING SCREEN DEVICES
C
	CALL PPLOT(0.,0.,10)		! EJECT PRINTER PAGE
	RETURN
	END
C
	SUBROUTINE FACTOR(SC)
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C	CHANGE SCALE FACTORS FOR ALL PLOT PACKAGES
C
C	SC  SCALE FACTOR
C
	COMMON/PXPCOM/LU,MP,RE(2),OX,OY,SF,PX,PY,MX,MW,MCOL,MSC,
     $		PANG,PVP(4)
C
	COMMON/RMTEK/ICHAN,IMR(128),RRE(2),ROX,ROY,RSF,NIMR,RANG,MM,IPW,
     $		IPSC,ICOL,RVP(4),IRID,RLIM(2),IRXLIM,IRYLIM,IDDEV
C
	COMMON/VT100/IVT100,IMV(32),VRE(2),VOX,VOY,VSF,NIMV,VANG,ITERM,
     $		VVP(4),MV,MVW,IVCOL,IXLIM,IYLIM,IYREV,VLIM(2)
C
	IF (LU.GE.0) CALL PFACTOR(SC)
	IF (ICHAN.GE.0) CALL RFACTOR(SC)
	IF (IVT100.GE.0) CALL VFACTOR(SC)
	RETURN
	END
C
	SUBROUTINE NEWPEN(IP)
C
C	CHANGE PLOTTING LINE TYPE ON ALL DEVICES
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C
C IP	PEN TYPE CONTROL WORD 
C		NOTE: IP<0 RESETS PEN WIDTH TO 1 AND LINE TYPE TO SOLID
C
C	NOTE ALL GRAPHICS SUPPORT ALL HARWARE LINE TYPES.  IF THEY DO,
C	THE LINE TYPES SHOULD RESEMBLE THESE:
C
C	UNITS DIGIT = LINE TYPE 0-9
C		TYPE	PATTERN
C		 0	SOLID
C		 1	DOTTED
C		 2	LONG-DOT-LONG
C		 3	MEDDASH-MEDDASH
C		 4	LONGDASH-LONGDASH
C		 5	LONG-DOT-DOT-LONG
C		 6	LONG-SHORT-LONG
C		 7	SHORT-SHORT
C		 8	LONG-DOT-DOT-DOT-LONG
C		 9	VERYSHORT-VERYSHORT
C
C	TENS  DIGIT = LINE WIDTH IN PIXELS OR DOTS
C	  0 = NO CHANGE
C	  1-7 LINE WIDTH
C
C	HUNDREDS DIGIT = LINE TYPE SCALE FACTOR
C	  0 = NO CHANGE
C	  1-9 LINE TYPE SCALE FACTOR
C
C	FIRST PICK UP PEN AT CURRENT LOCATION, THEN CHANGE LINE TYPE
C
	CALL PLOT(0.,0.,5)
C
	CALL RMPEN(IP)
	CALL PPEN(IP)
	CALL VPEN(IP)
	RETURN
	END
C
	SUBROUTINE PLOTND
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C	TERMINATES PLOTS 
C
	CALL PLOT(0.,0.,999)
	RETURN
	END
C
C
	SUBROUTINE FIXRM0(ORX,ORY,ZOM,ANG,RX,RY,NT,NS,ICOLOR,NCHAN)
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C	SET PLOT COMMON DATA TO ABSOLUTE KNOWN VALUES
C	NO ERROR CHECKING PROVIDED
C
	COMMON/RMTEK/ICHAN,IMR(128),RRE(2),ROX,ROY,RSF,NIMR,RANG,MM,IPW,
     $		IPSC,ICOL,RVP(4),IRID,RLIM(2),IRXLIM,IRYLIM,IDDEV
C
	ROX=ORX				! X ORIGIN
	ROY=ORY				! Y ORIGIN
	RSF=ZOM				! ZOOM SCALE FACTOR
	RANG=ANG			! PLOTTING ANGLE
C	RRE(1)=RX*RSF			! X DIRECTION RESOLUTION
C	RRE(2)=RY*RSF			! Y DIRECTION RESOLUTION
	MM=NT				! LINE TYPE
	IPW=NS				! PIXEL SCALING OF LINE TYPE
	ICHAN=NCHAN			! CHANNEL NUMBER IF NCHAN > 0
	ICOL=ICOLOR			! CURRENT COLOR TABLE VALUE
	CALL RMTEXTURE(ICHAN,MM,IPW,IPSC,IERR)
	RETURN
	END
C
	SUBROUTINE FIXVT0(ORX,ORY,ZOM,ANG,RX,RY,NVT,ISEL,NT,NW,NCOL)
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C	SET PLOT COMMON DATA TO ABSOLUTE KNOWN VALUES
C	NO ERROR CHECKING PROVIDED
C
	COMMON/VT100/IVT100,IMV(32),VRE(2),VOX,VOY,VSF,NIMV,VANG,ITERM,
     $		VVP(4),MV,MVW,IVCOL,IXLIM,IYLIM,IYREV,VLIM(2)
	VOX=ORX				! X ORIGIN
	VOY=ORY				! Y ORIGIN
	VSF=ZOM				! ZOOM SCALE FACTOR
	VANG=ANG			! PLOTTING ANGLE
C	VRE(1)=RX*VSF			! X DIRECTION RESOLUTION
C	VRE(2)=RY*VSF			! Y DIRECTION RESOLUTION
	IVT100=NVT			! NVT > 0 MEANS VT ENABLED
	ITERM=ISEL			! INTERNAL TERMINAL CODE
	MV=NT				! LINE TYPE
	MVW=NW				! LINE WIDTH
	IVCOL=NCOL			! LINE COLOR
	CALL NEWVPEN(MV,MVW)		! CHANGE TERMINAL LINE TYPE
	RETURN
	END
C
	SUBROUTINE FIXPR0(ORX,ORY,AX,AY,ZOM,ANG,RX,RY,NVT,MXX,MWW,MCOLL)
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C	SET PRINTER COMMON DATA TO ABSOLUTE KNOWN VALUES
C	NO ERROR CHECKING PROVIDED
C
	COMMON/PXPCOM/LU,MP,RE(2),OX,OY,SF,PX,PY,MX,MW,MCOL,MSC,
     $		PANG,PVP(4)
	OX=ORX				! X ORIGIN
	OY=ORY				! Y ORIGIN
	PX=AX				! LAST SCALED, SHIFTED X
	PY=AY				! LAST SCALED, SHIFTED Y
	SF=ZOM				! ZOOM SCALE FACTOR
	PANG=ANG			! PLOTTING ANGLE
C	RE(1)=RX*SF			! X DIRECTION RESOLUTION
C	RE(2)=RY*SF			! Y DIRECTION RESOLUTION
	LU=NVT				! NVT > 0 MEANS PR ENABLED
	MX=MXX				! LINE TYPE
	MW=MWW				! LINE WIDTH
	MCOL=MCOLL			! LINE COLOR
C WRITE DATA TO FILE
	IF (LU.GT.0) THEN
		CALL PPLOTP(MX,MSC,1001)	! LINE TYPE, SCALE
		CALL PPLOTP(MW,MCOL,1002)	! LINE COLOR
		CALL PPLOTP(MW,0,1003)		! LINE WIDTH
	ENDIF
	RETURN
	END
C
C
	SUBROUTINE WHERE(X,Y,Z)
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C
C	RETURN LAST VALUES IN CALL TO PLOT.
C
C	X,Y	(R): 	LAST POSITION
C	Z	(R):	SCALE FACTOR--PRIORITIZED TERMINAL,RAMTEK,PRINTER
C
	COMMON/PXPCOM/LU,MP,RE(2),OX,OY,SF,PX,PY,MX,MW,MCOL,MSC,
     $		PANG,PVP(4)
C
	COMMON/RMTEK/ICHAN,IMR(128),RRE(2),ROX,ROY,RSF,NIMR,RANG,MM,IPW,
     $		IPSC,ICOL,RVP(4),IRID,RLIM(2),IRXLIM,IRYLIM,IDDEV
C
	COMMON/VT100/IVT100,IMV(32),VRE(2),VOX,VOY,VSF,NIMV,VANG,ITERM,
     $		VVP(4),MV,MVW,IVCOL,IXLIM,IYLIM,IYREV,VLIM(2)
C
	COMMON/LSTPLT/XLAST,YLAST,I0LAST
	X=XLAST
	Y=YLAST
	Z=SF
	IF (ICHAN.GT.0) Z=RSF
	IF (IVT100.GT.0) Z=VSF
	RETURN
	END
C
	SUBROUTINE ABSPLT(X,Y,A,Z)
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C
C	SET PLOTTING ORIGIN, ANGLE, AND SCALE FACTOR TO ABSOLUTE UNITS
C	NO ERROR CHECKING DONE
C
C	X,Y	NEW ORIGIN
C	A	NEW ANGLE
C	Z	NEW SCALE FACTOR
C
	CALL WHEREVT(ORX,ORY,ZOM,ANG,RX,RY,NVT,ISEL,NT,NW,NCOL)
	CALL FIXVT0(X,Y,Z,A,RX,RY,NVT,ISEL,NT,NW,NCOL)
	CALL WHEREPR(ORX,ORY,AX,AY,ZOM,ANG,RX,RY,NLU,MXX,MWW,MCOLL)
	CALL FIXPR0(X,Y,AX,AY,Z,A,RX,RY,NLU,MXX,MWW,MCOLL)
	CALL WHERERM(ORX,ORY,ZOM,ANG,RX,RY,NT,NS,ICOLOR,NCHAN)
	CALL FIXRM0(X,Y,Z,A,RX,RY,NT,NS,ICOLOR,NCHAN)
	RETURN
	END
C
C
C
	SUBROUTINE SAVPL
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C
C	CENTRAL ROUTINE TO SAVE THE CURRENT PLOTTING STATE
C
	CALL WHERE(X,Y,Z)	! GET LAST PLOT COMMAND
	CALL PLOT(X,Y,3)	! DO PENUP
	CALL PSAVPL
	CALL RSAVPL
	CALL VSAVPL
	RETURN
	END
C
	SUBROUTINE RESPL
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C
C	CENTRAL ROUTINE TO SAVE THE CURRENT PLOTTING STATE
C
	CALL WHERE(X,Y,Z)	! GET LAST PLOT COMMAND
	CALL PLOT(X,Y,3)	! DO PENUP
	CALL PRESPL
	CALL RRESPL
	CALL VRESPL
	RETURN
	END
C
C
	SUBROUTINE PSAVPL
C
C	ROUTINE TO SAVE THE CURRENT PRINTER HISTORY FILE PLOTTING STATE
C	SAVES UP TO SIX LEVELS OF SOFTWARE STACK
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C
	DIMENSION SOX(6),SOY(6),SSF(6),SANG(6),SVP(4,6)
	INTEGER ISCOL(6),ISMW(6),ISMX(6),IMSC(6)
C
	COMMON/PXPCOM/LU,MP,RE(2),OX,OY,SF,PX,PY,MX,MW,MCOL,MSC,
     $		PANG,PVP(4)
C
	DATA NS/0/
C
	IF (LU.LE.0) RETURN
	IF (NS.GT.5) RETURN	! STACK OVERFLOW
	NS=NS+1
	SOX(NS)=OX
	SOY(NS)=OY
	SSF(NS)=SF
	SANG(NS)=PANG
	DO 1 I=1,4
		SVP(I,NS)=PVP(I)
1	CONTINUE
	ISMX(NS)=MX
	IMSC(NS)=MSC
	ISMW(NS)=MW
	ISCOL(NS)=MCOL
	RETURN
C
	ENTRY PRESPL
C
C	RESTORES SAVED PRINTER HISTORY PLOTTING STATE
C
	IF (NS.LT.1) RETURN	! EMPTY STACK
	OX=SOX(NS)
	OY=SOY(NS)
	SF=SSF(NS)
	PANG=SANG(NS)
	DO 2 I=1,4
		PVP(I)=SVP(I,NS)
2	CONTINUE
	MX=ISMX(NS)
	MSC=IMSC(NS)
	MW=ISMW(NS)
	MCOL=ISCOL(NS)
	CALL PPLOTP(MX,MSC,1001)	! LINE TYPE, SCALE
	CALL PPLOTP(MW,MCOL,1002)	! LINE COLOR
	CALL PPLOTP(MW,0,1003)		! LINE WIDTH
	NS=NS-1
	RETURN
	END
C
	SUBROUTINE RSAVPL
C
C	ROUTINE TO SAVE THE CURRENT RAMTEK PLOTTING STATE
C	SAVES UP TO SIX LEVELS OF SOFTWARE STACK
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C
	DIMENSION SOX(6),SOY(6),SSF(6),SANG(6),SVP(4,6)
	INTEGER ISCOL(6),ISPW(6),ISMM(6),ISPSC(6)
C
	COMMON/RMTEK/ICHAN,IMR(128),RRE(2),ROX,ROY,RSF,NIMR,RANG,MM,IPW,
     $		IPSC,ICOL,RVP(4),IRID,RLIM(2),IRXLIM,IRYLIM,IDDEV
C
	DATA NS/0/
C
	IF (NS.GT.5) RETURN	! STACK OVERFLOW
	NS=NS+1
	SOX(NS)=ROX
	SOY(NS)=ROY
	SSF(NS)=RSF
	SANG(NS)=RANG
	DO 1 I=1,4
		SVP(I,NS)=RVP(I)
1	CONTINUE
	ISCOL(NS)=ICOL
	ISMM(NS)=MM
	ISPW(NS)=IPW
	ISPSC(NS)=IPSC
	RETURN
C
	ENTRY RRESPL
C
C	RESTORES SAVED RAMTEK PLOTTING STATE
C
	IF (NS.LT.1) RETURN	! EMPTY STACK
	ROX=SOX(NS)
	ROY=SOY(NS)
	RSF=SSF(NS)
	RANG=SANG(NS)
	DO 2 I=1,4
		RVP(I)=SVP(I,NS)
2	CONTINUE
	ICOL=ISCOL(NS)
	MM=ISMM(NS)
	IPW=ISPW(NS)
	IPSC=ISPSC(NS)
	CALL RMTEXTURE(ICHAN,MM,IPW,IPSC,IERR)
	NS=NS-1
	RETURN
	END
C
	SUBROUTINE VSAVPL
C
C	ROUTINE TO SAVE THE CURRENT TERMINAL PLOTTING STATE
C	SAVES UP TO SIX LEVELS OF SOFTWARE STACK
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C
	DIMENSION SOX(6),SOY(6),SSF(6),SANG(6),SVP(4,6)
	INTEGER ISMV(6),ISMW(6),ISCOL(6)
C
	COMMON/VT100/IVT100,IMV(32),VRE(2),VOX,VOY,VSF,NIMV,VANG,ITERM,
     $		VVP(4),MV,MVW,IVCOL,IXLIM,IYLIM,IYREV,VLIM(2)
C
	DATA NS/0/
C
	IF (NS.GT.5) RETURN	! STACK OVERFLOW
	NS=NS+1
	SOX(NS)=VOX
	SOY(NS)=VOY
	SSF(NS)=VSF
	SANG(NS)=VANG
	DO 1 I=1,4
		SVP(I,NS)=VVP(I)
1	CONTINUE
	ISMV(NS)=MV
	ISMW(NS)=MVW
	ISCOL(NS)=IVCOL
	RETURN
C
	ENTRY VRESPL
C
C	RESTORES SAVED TERMINAL PLOTTING STATE
C
	IF (NS.LT.1) RETURN	! EMPTY STACK
	VOX=SOX(NS)
	VOY=SOY(NS)
	VSF=SSF(NS)
	VANG=SANG(NS)
	DO 2 I=1,4
		VVP(I)=SVP(I,NS)
2	CONTINUE
	MV=ISMV(NS)
	MVW=ISMW(NS)
	IVCOL=ISCOL(NS)
	CALL NEWVPEN(MV,MVW)
	CALL PLOTVT(FLOAT(IVCOL),0.,0)
	NS=NS-1
	RETURN
	END
C
C *************************************************************************
C
C THE FOLLOWING ROUTINES ARE BASED ON THE DEC VAX ASYNCHRONOUS CONTROL-C
C INTERRUPT HANDLING PROTOCALL.  "ENAST" IS A MACHINE DEPENDENT ROUTINE
C WHICH ENABLES/DISABLES THE CONTROL-C INTERRUPT.  IT IS CALLED BY "ENABLEAST"
C TO ENABLE THE INTERRUPT AND BY "ASTEXIT" (WHICH IS CALLED WHEN INTERRUPT
C OCCURS).  IN THIS FILE, WE REPLACE THESE ROUTINES WITH DUMMY CALLS SO
C THAT THE CONTROL-C ROUTINES ARE NOT USED.  A SEPARATE FILE CONTAINS
C THE WORKING CODE.  THE OTHER FILE CAN BE SUBSTITUTED TO ALLOW CONTROL-C
C INTERRUPTS.  WHEN AN INTERRUPT OCCURS, WE SET A FLAG IN THE "ASTC"
C COMMON BLOCK AND CONTINUE IF THE TERMINAL PACKAGE IN LONGLIB IS IN USE
C OTHERWISE WE DIRECTLY CALL THE INTERRUPT HANDLER "ASTINTER".  IF THE
C TERMINAL PACKAGE IS IN USE, EACH TIME "PLOT" IS CALLED WE CHECK THE STATUS
C OF THE FLAG.  IF THE FLAG IS SET WE CALL THE INTERRUPT HANDLER "ASTINTER"
C WHICH CAN EXIT THE PROGRAM, RESET TERMINAL CONDITION, ETC.  IN THIS WAY
C WE CAN USE THE CONTROL-C STUFF WITH OR WITHOUT LONGLIB BE USED AT ALL.
C IF YOU WISH TO USE THE CONTROL-C STUFF WITHOUT THE REST OF LONGLIB,
C CALL "ENABLEAST" FROM YOUR CODE.  THE LONGLIB ROUTINE "FRAME" CALLS
C "ENABLAST" WHEN THE LONGLIB PACKAGE IS USED.
C
C YOU CAN ELIMINATE THESE ROUTINES IF DESIRED.  IF THIS IS DONE BE SURE
C TO COMMENT OUT THE CONTROL-C LINES IN THE ROUTINE 'PLOT' AND 'FRAME'.
C
C **********************************************************************
C
	SUBROUTINE ENABLEAST
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C	ENABLE CONTROL-C INTERRUPT
C
C	DUMMY ROUTINE
C
	COMMON/ASTC/IASTFL,IASTPL
	IASTFL=0			! CONTROL-C INTERRUPT FLAG
	IASTPL=0			! CURRENTLY PLOTTING FLAG
	RETURN
	END
C
	SUBROUTINE ENAST(IOPT)
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C	CONTROL-C INTERRUPT QIO SET UP
C
C	DUMMY ROUTINE
C
	RETURN
	END
C
C
	SUBROUTINE ASTEXIT(IOPT)
C
C	FORTRAN-77 VERSION:   DGL JULY, 1987
C
C	ROUTINE CALLED IN THE EVENT OF A CONTROL-C FROM THE TERMINAL.
C	A FLAG (IASTFL) IS SET AND IF WE ARE PLOTTING TO THE TERMINAL
C	THE ROUTINE RETURNS.  IF NOT PLOTTING TO THE TERMINAL, THE
C	CONTROL-C HANDLER IS CALLED IMMEDIATELY
C
	COMMON/ASTC/IASTFL,IASTPL
	COMMON/VT100/IVT100,IMV(32),VRE(2),VOX,VOY,VSF,NIMV,VANG,ITERM,
     $		VVP(4),MV,MVW,IVCOL,IXLIM,IYLIM,IYREV,VLIM(2),IMODE
	CHARACTER*1 IANS
C
	CALL ENAST(IOPT)		! RESET CONTORL-C QIO
	IF (IASTFL.LT.0) RETURN		! NO CONTROL-C INTERRUPTS DURING
C					!  A CONTROL-C INTERRUPT
	IF (IVT100.LT.0) THEN		! TERMINAL PACKAGE NOT IN CURRENT USE
		IASTFL=0		! IMMEDIATELY CALL INTERRUPT HANDLER
		CALL ASTINTER(IASTFL)
	ELSE				! TERMINAL PACKAGE IN USE
		IF (IASTPL.EQ.1) THEN	! CURRENTLY PLOTTING, INTERRUPT LATER
			IASTFL=1
		ELSE			! NOT PLOTTING, INTERRUPT NOW
			IASTFL=0
			CALL ASTINTER(IASTFL)
		ENDIF
	ENDIF
	RETURN
	END
C
C
	SUBROUTINE ASTINTER(IV)
C
C	CONTROL-C INTERUPT HANDLING CODE
C	USES THE CURRENT MODE OF THE GRAPHICS TERMINAL TO INSURE THAT
C	TERMINAL IS IN TERMINAL MODE AND IS RETURNED TO GRAPHICS MODE
C	IF IN THAT MODE.  IF LONGLIB IS NOT ENABLED, THE OPTION TO CONTINUE
C	OR ABORT PROGRAM IS GIVEN.
C
	CHARACTER*1 IANS
C
	COMMON/ASTC/IASTFL,IASTPL
	COMMON/VT100/IVT100,IMV(32),VRE(2),VOX,VOY,VSF,NIMV,VANG,ITERM,
     $		VVP(4),MV,MVW,IVCOL,IXLIM,IYLIM,IYREV,VLIM(2),IMODE
C
	IASTFL=-1		! ENTERING HANDLER SO FLAG NO INTERRUPT
	ISMODE=IMODE		! SAVE CURRENT GRAPHICS/TERMINAL MODE
	CALL CTERM(1)		! PUT TERMINAL IN TERMINAL MODE
	WRITE (*,1)
1	FORMAT(/' *** CONTROL-C INTERRUPT ***')
505	WRITE (*,2)
2	FORMAT('$<RET> TO CONTINUE <^Z> TO ABORT: ')
	READ (*,3,END=99) IANS
	IF (IANS.EQ.'?') THEN
		WRITE(*,84)
84		FORMAT(/'X,Z: Abort program'/
     $		' C : Clear screen '/
     $		' Q : Quit (disable screen plotting)'/
     $		' S : Skip screen plotting until next "clear screen"'/,
     $		' R : Reset skip'/,
     $		' U : Unquit'/,
     $		' T : Set screen to terminal mode'/,
     $		' G : Set screen to graphics mode')
		GOTO 505
	ENDIF
	IF (IANS.EQ.'Z'.OR.IANS.EQ.'z') GOTO 99		! TERMINATE PROGRAM
	IF (IANS.EQ.'X'.OR.IANS.EQ.'x') THEN		! TERMINATE/CLEAR
		CALL CTERM(2)
		GOTO 99
	ENDIF
	IF (IANS.EQ.'C'.OR.IANS.EQ.'c') CALL CTERM(-2)	! CLEAR SCREEN
	IF (IANS.EQ.'Q'.OR.IANS.EQ.'q') IVT100=-98  ! TURN OFF SCREEN PLOTTING
	IF (IANS.EQ.'S'.OR.IANS.EQ.'s') IVT100=-99	! SKIP PLOTTING
	IF (IANS.EQ.'R'.OR.IANS.EQ.'r'.AND.IVT100.EQ.-99) THEN ! RESET SKIP
		IVT100=1
		ISMODE=1
	ENDIF
	IF (IANS.EQ.'U'.OR.IANS.EQ.'u'.AND.IVT100.EQ.-98) THEN ! UNQUIT
		IVT100=1
		ISMODE=1
	ENDIF
 	IF (IANS.EQ.'T'.OR.IANS.EQ.'t') ISMODE=0	! TERMINAL MODE
	IF (IANS.EQ.'G'.OR.IANS.EQ.'g') ISMODE=1	! GRAPHICS MODE
3	FORMAT(A1)
	IF (ISMODE.EQ.1) CALL CTERM(-1)		! RESTORE TERMINAL GRAPHICS MODE
	IASTFL=0				! EXIT HANDLER
	RETURN
99	CALL EXIT				! TERMINATE PROGRAM
	END
